如何打开文件夹中的所有CSV文件，将文本运行到列，然后另存为新文件

Question

我必须对宏进行排序以读取文件夹中的所有CSV，应用分隔符，然后另存为新文件.
目前，我可以让它打开文件夹中的所有CSV并将它们另存为新的工作簿，但是在该过程中间将文本应用于列被证明是棘手的。

Sub CSVtoXLS()
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Title = "Select a folder:"
If xFd.Show = -1 Then
    xSPath = xFd.SelectedItems(1)
Else
    Exit Sub
End If
If Right(xSPath, 1) <> "" Then xSPath = xSPath + ""
xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
    Application.StatusBar = "Converting: " & xCSVFile
    Workbooks.Open Filename:=xSPath & xCSVFile
    
    Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
    1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
    , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
    Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
    25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), _
    Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array( _
    38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1)), TrailingMinusNumbers _
    :=True
    
    ActiveWorkbook.Close
    Windows(xWsheet).Activate
    xCSVFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub

Answer 1

将 csv 文件放在与工作簿相同的目录中后，请尝试以下代码。

Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".csv"
Sub csvToXLSX()
  theDir = ThisWorkbook.Path
  s = Dir(theDir & "*" & ext)
  While s <> ""
    Set wk = Workbooks.Open(theDir & "" & s)
    Set r = Range(Range("A1"), Range("A1").End(xlDown))
    r.TextToColumns Destination:=r, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
    "|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
    , TrailingMinusNumbers:=True
    Application.DisplayAlerts = False
    wk.SaveAs Filename:=theDir & "" & s & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    wk.Close False
    Application.DisplayAlerts = True
    s = Dir()
    numFiles = numFiles + 1
  Wend
  MsgBox (numFiles & " files were processed.")
End Sub