将多个CSV文件合并到一个工作簿(每个工作表将以其原始文件名的前缀命名) VBA

Sub MergeCSVFiles()
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim CSVFile As Variant
    
    '选择包含CSV文件的文件夹路径
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含CSV文件的文件夹"
        If .Show = -1 Then
            FolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    '创建一个新的工作簿
    Set wb = Workbooks.Add
    
    '循环处理文件夹中的每个CSV文件
    FileName = Dir(FolderPath & "\*.csv")
    Do While FileName <> ""
        '打开CSV文件
        Set ws = wb.Worksheets.Add
        With ws.QueryTables.Add(Connection:="TEXT;" & FolderPath & "\" & FileName, Destination:=ws.Range("A1"))
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True
            .Refresh
        End With
        
        '将工作表重命名为原始文件名的前缀
        ws.Name = Left(FileName, Len(FileName) - 4)
        
        '继续处理下一个CSV文件
        FileName = Dir
    Loop
    
    '保存合并后的工作簿
    wb.SaveAs FolderPath & "\合并后的工作簿.xlsx"
    
    '关闭工作簿
    wb.Close
    
    MsgBox "CSV文件已成功合并到一个工作簿中。", vbInformation
End Sub