批量TXT转Excel Workbook开发求助：多文件导入多Sheet

核心功能实现代码 #

直接用这段VBA代码替换你现有的代码，完全适配你的需求：

Sub BatchConvertTXTtoExcel()
    Dim fd As FileDialog
    Dim selectedFiles As Variant
    Dim newWB As Workbook
    Dim ws As Worksheet
    Dim fileIndex As Integer
    Dim saveFD As FileDialog
    Dim savePath As String
    
    ' 选择最多50个TXT文件
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Filters.Add "逗号分隔TXT文件", "*.txt"
        .Title = "选择最多50个逗号分隔TXT文件"
        .ButtonName = "选择文件"
        If .Show <> -1 Then Exit Sub
        selectedFiles = .SelectedItems
    End Set
    Set fd = Nothing
    
    ' 检查选择文件数量不超过50
    If UBound(selectedFiles) > 49 Then
        MsgBox "最多只能选择50个文件，请重新选择", vbExclamation
        Exit Sub
    End If
    
    ' 创建新工作簿
    Set newWB = Workbooks.Add
    
    ' 逐个导入TXT文件到新工作表
    For fileIndex = LBound(selectedFiles) To UBound(selectedFiles)
        ' 新建工作表（跳过默认的第一个表，从第二个开始）
        If fileIndex > LBound(selectedFiles) Then
            newWB.Sheets.Add After:=newWB.Sheets(newWB.Sheets.Count)
        End If
        Set ws = newWB.Sheets(fileIndex)
        
        ' 导入逗号分隔的TXT数据
        With ws.QueryTables.Add(Connection:="TEXT;" & selectedFiles(fileIndex), Destination:=ws.Range("A1"))
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True
            .TextFileColumnDataTypes = Array(xlGeneralFormat)
            .Refresh BackgroundQuery:=False
            .Delete ' 删除查询表，保留纯数据
        End With
        
        ' 设置工作表名为TXT文件名（去掉后缀）
        ws.Name = Left(Dir(selectedFiles(fileIndex)), InStr(Dir(selectedFiles(fileIndex)), ".") - 1)
    Next fileIndex
    
    ' 选择保存路径和文件名
    Set saveFD = Application.FileDialog(msoFileDialogSaveAs)
    With saveFD
        .Title = "保存转换后的Excel文件"
        .FilterIndex = 2 ' 选择.xlsx格式
        .FileName = "TXT转换结果"
        If .Show <> -1 Then
            newWB.Close SaveChanges:=False
            Exit Sub
        End If
        savePath = .SelectedItems(1)
    End Set
    Set saveFD = Nothing
    
    ' 保存新工作簿并关闭
    newWB.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
    newWB.Close SaveChanges:=False
    
    MsgBox "转换完成！文件已保存至：" & savePath, vbInformation
End Sub

代码适配说明 #

• 多文件选择：通过msoFileDialogFilePicker启用多选，限制仅显示.txt文件，同时检查数量不超过50个
• 逗号分隔解析：使用QueryTables导入时指定TextFileCommaDelimiter = True，完美适配逗号分隔的TXT格式
• 工作表命名：自动提取TXT文件名作为对应工作表名称，避免默认命名混乱
• 保存流程：通过msoFileDialogSaveAs让用户指定保存路径和文件名，默认格式为xlsx

使用步骤 #

• 打开你的Excel转换工具文件
• 按Alt+F11打开VBA编辑器
• 插入一个新模块（右键项目→插入→模块）
• 将上述代码粘贴到模块中
• 返回Excel界面，添加一个按钮（开发工具→插入→按钮），关联这个BatchConvertTXTtoExcel宏
• 点击按钮即可执行批量转换流程

内容的提问来源于stack exchange，提问作者jwrichard01