如何使用 excel vba 将 excel 文件转换为 CSV 文件（管道分隔）

Question

I want to convert the simple excel files into CSV(pipe delimited) using excel vba I tried to many code but cant get expected output

following code I tried

      Sub mergeFiles()
        Dim xlwkbInput1  As Workbook
        Dim xlshtInput1  As Worksheet
        Dim xlwbfinalrpt As Workbook
        Dim xlshtfinalrpt As Worksheet

        Dim rcount1 As Long

        Dim xlwkbInput2  As Workbook
        Dim xlshtInput2 As Worksheet
        Dim xlapp As Excel.Application


        Set xlapp = New Excel.Application
        xlapp.Visible = True               

           Set xlwkbInput1 = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\Operative_CashFlow_Report.xlsx")
           Set xlwkbInput2 = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\Collection_CashFlow_Report.xlsx")

           xlwkbInput2.Sheets("Sheet1").Activate
           xlwkbInput2.ActiveSheet.UsedRange.Copy

           xlwkbInput1.Sheets("Sheet1").Activate
           rcount = xlwkbInput1.ActiveSheet.UsedRange.Rows.Count

           xlwkbInput1.Sheets("Sheet1").Range("A" & CStr(rcount + 1)).PasteSpecial

           xlwkbInput1.UsedRange("$A$1:$I$274").AutoFilter Field:=1, Criteria1:=Array( _
           "LIC106", "LIC107", "LIC134", "LIC138", "="), Operator:=xlFilterValues
           xlwkbInput1.UsedRange.Delete             
           xlwkbInput1.SaveAs ActiveWorkbook.Path & "\Output\final_report.xlsx"              
           Set xlwbfinalrpt = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\final_report.xlsx")       
           xlwbfinalrpt.Sheet("Sheet1").Activate

            xlwbfinalrpt.SaveAs ActiveWorkbook.Path & "\Output\final_report.xlsx"      

    xlwbfinalrptwb = Workbooks.Open (ActiveWorkbook.Path & "\Output\final_report.xlsx" 

         xlwbfinalrptwb .SaveAs fileName:=ActiveWorkbook.Path & "\Output\final_report.xlsx"
    , FileFormat:=xlCSV, CreateBackup:=False  

' here I m doing conversion of excel to CSV file

End Sub

Answer 1

You can save an Excel file as comma delimited or tab delimited but not pipe delimited.

Here is how you can achieve pipe delimited export.

Basic Sample

Just to show here the fundamentals.

Sub Writing_to_a_text_file()
    Dim N As Integer
    Dim FileName As String

    'Define where to save the output file.
    FileName = Environ("USERPROFILE") & "\Desktop\" & "Sample1.csv" 

    'Get a free file number
    N = FreeFile

    Open FileName For Output As #N
        '"Print" print data into the file. Another method is "Write". 
        'Both do the same job but behave slightly differently. Try Google it.
        Print #N, "This is a test" 
        Print #N, "Writing another line here" 
        Print #N, Join(Array("Pipe", "delimited", "line", "here"), "|") 
        Print #N, vbNullString '<- this create an empty line
    Close N
End Sub

Export a range of data in pipe delimited format into a text file

Sub ExportToTextFile()
'Export range("A1:E10") data to a text file in pipe delimited format.
    Dim N As Integer
    Dim FileName As String
    Dim R As Long, C As Long, DataLine As String

    FileName = Environ("USERPROFILE") & "\Desktop\" & "TextOutput.csv" 

    N = FreeFile

    Open FileName For Output As #N
        For R = 1 To 10
            DataLine = vbNullString
            For C = 1 To 5
                DataLine = DataLine & "|" & Cells(R, C).Value2
            Next C
            DataLine = Right(DataLine, Len(DataLine) - 1)
            Print #N, DataLine
        Next R
    Close N
End Sub

Answer 2

If you just want to save a sheet out as a pipe delimited file then this should work for you:

Sub DelimFile()

Open "C:\output.txt" For Output As 1 'Change this path

rowno = 1
colcount = Application.CountA(ActiveSheet.Rows(1))
While activesheet.Cells(rowno, 1) <> ""
    dataout = ""
    For c = 1 To colcount
        If c <> colcount Then
            dataout = dataout & """" & Trim(activesheet.Cells(rowno, c)) & """|"
        Else
            dataout = dataout & """" & Trim(activesheet.Cells(rowno, c)) & """"
        End If
    Next c
    Print #1, dataout
    rowno = rowno + 1
Wend
Close #1
End Sub