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

how to convert excel file to CSV file (pipe delimited) using excel vba

提问by vivek padelkar

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

我想使用 excel vba 将简单的 excel 文件转换为 CSV（管道分隔）我尝试了很多代码但无法获得预期的输出

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:$I4").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

' 在这里，我正在将 excel 转换为 CSV 文件

End Sub

采纳答案by Rosetta

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

您可以将 Excel 文件保存为逗号分隔或制表符分隔但不是管道分隔。

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

回答by Fraser T

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