使用管道分隔符Excel到CSV单元格

时间:2015-05-12 04:29:17

标签: vba excel-vba batch-file excel

如何用管道替换逗号分隔符“|”分隔符。来源:Batch convert Excel to text-delimited files

Option Explicit
Dim oFSO, myFolder
Dim xlCSV
myFolder="C:\your\path\to\excelfiles\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlCSV = 6 'Excel CSV format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox ("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile in oFileList
    If (Right(oFile.Name, 4) = "xlsx") Then
        Set oWB = oExcel.Workbooks.Open(oFile.Path)
        For Each oWSH in oWB.Sheets
            Call oWSH.SaveAs (oFile.Path & oWSH.Name & ".csv", xlCSV)
        Next
        Set oWSH = Nothing
        Call oWB.Close
        Set oWB = Nothing
    End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub

1 个答案:

答案 0 :(得分:1)

这是我使用的导出管道例程,在大型数据集上可能很慢:

Sub SaveCopy()
    'This savecopy routine will output to a pipe delimited file, good for bulk inserting into an Oracle DB
    Dim vFileName As Variant
    Dim rngLastCell As Range
    Dim lLastRow As Long
    Dim nLastCol As Integer
    Dim lCurrRow As Long
    Dim nCurrCol As Integer
    Dim sRowString As String
    Dim ArchiveFolder As String
    ArchiveFolder = "C:\Temp\"
    Application.DisplayAlerts = False
    vFileName = ArchiveFolder & "Daily" & Format(Now(), "YYYYMMDDHHMMSS") & ".txt"
    Open vFileName For Output As #1
    Set rngLastCell = ActiveSheet.Range("A1").SpecialCells(xlLastCell)
    lLastRow = Range("A" & Rows.Count).End(xlUp).Row
    nLastCol = Range("XFD1").End(xlToLeft).Column
    For lCurrRow = 1 To lLastRow
        sRowString = join(application.transpose(application.transpose(Range("A" & lCurrRow).Resize(1,nLastCol))),"|")
        If Len(sRowString) = nLastCol - 1 Then
            Print #1,
        Else
            Print #1, sRowString
        End If
    Next lCurrRow
    Close #1
    'ActiveWindow.Close False
    Application.DisplayAlerts = True
End Sub