Excel VBA实现文件夹选择及批量加载TXT文件至工作表

以下是修改后的VBA代码，实现选择目标文件夹后批量加载所有.txt文件内容到指定工作表，同时保留原代码的文本处理逻辑：

Sub BatchLoadTxtFiles()
    Dim folderPath As String
    Dim txtFileName As String
    Dim textFileNum As Integer
    Dim textData As String
    Dim tArray() As String
    Dim sArray() As String
    Dim rowNum As Long, colNum As Long
    Dim NextRow As Long
    Dim textDelimiter As String
    
    ' 设置文本分隔符，与原代码保持一致
    textDelimiter = ","
    
    ' 弹出文件夹选择对话框
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含TXT文件的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹，程序终止", vbInformation
            Exit Sub
        End With
    End With
    
    ' 指定目标工作表，可替换为实际工作表名称（如"数据工作表"）
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    ' 获取当前工作表最后一行，作为内容追加的起始行
    NextRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row + 1
    
    ' 遍历文件夹内所有TXT文件
    txtFileName = Dir(folderPath & "*.txt")
    Do While txtFileName <> ""
        ' 读取TXT文件内容
        textFileNum = FreeFile
        Open folderPath & txtFileName For Input As textFileNum
        textData = Input(LOF(textFileNum), textFileNum)
        Close textFileNum
        
        ' 按换行拆分文本为行数组
        tArray() = Split(textData, vbLf)
        
        ' 逐行处理并写入工作表
        For rowNum = LBound(tArray) To UBound(tArray) - 1
            If Len(Trim(tArray(rowNum))) <> 0 Then
                sArray = Split(tArray(rowNum), textDelimiter)
                ' 写入当前行的各列数据
                For colNum = LBound(sArray) To UBound(sArray)
                    targetSheet.Cells(NextRow, colNum + 1) = sArray(colNum)
                Next colNum
                NextRow = NextRow + 1 ' 更新下一行写入位置
            End If
        Next rowNum
        
        ' 获取下一个TXT文件
        txtFileName = Dir
    Loop
    
    ' 执行文本分列操作，参数与原代码一致
    targetSheet.Columns("A:A").TextToColumns _
        Destination:=targetSheet.Range("A1"), _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), _
        TrailingMinusNumbers:=True
        
    MsgBox "所有TXT文件加载完成！", vbInformation
End Sub

关键修改说明 #

• 替换选择方式：用文件夹选择对话框替代单个文件选择，适配批量处理场景
• 批量遍历文件：通过Dir函数循环获取文件夹下所有.txt文件，自动处理所有符合条件的文件
• 内容追加逻辑：用NextRow变量跟踪写入位置，确保每个文件的内容追加到已有内容下方，避免覆盖
• 明确工作表：指定固定目标工作表，避免依赖ActiveSheet导致的误操作
• 保留原有处理：完全继承原代码的文本拆分、空行过滤、文本分列逻辑，保证处理结果一致性

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