如何修改VBA单文件处理代码以批量处理数百个文本文件？

Hey there! Let's adjust your existing code to handle batch processing so you can work through hundreds of text files in one go. Here's the revised version with key improvements, plus explanations of the changes:

Sub BatchTransformTxt()
    Dim vFileNames As Variant
    Dim vFileName As Variant
    Dim SaveToDirectory As String
    Dim fd As FileDialog
    
    ' Let user select multiple text files (supports .edi and .txt)
    vFileNames = Application.GetOpenFilename( _
        FileFilter:="Text Files (*.edi;*.txt), *.edi;*.txt", _
        Title:="Select Text Files to Process", _
        MultiSelect:=True)
    
    ' Exit if no files are selected
    If TypeName(vFileNames) = "Boolean" Then
        MsgBox "No files selected. Exiting."
        Exit Sub
    End If
    
    ' Let user choose the save directory (avoids hardcoding paths)
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select Directory to Save Processed Files"
        If .Show = -1 Then
            SaveToDirectory = .SelectedItems(1) & "\"
        Else
            MsgBox "No save directory selected. Exiting."
            Exit Sub
        End If
    End With
    
    ' Loop through each selected file
    For Each vFileName In vFileNames
        On Error Resume Next ' Skip files that can't be processed (avoids crashing the batch)
        Workbooks.OpenText Filename:=vFileName, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="*", TrailingMinusNumbers:=True, _
            Local:=True
        
        ' Check if the file opened successfully before processing
        If Err.Number = 0 Then
            Call Transform ' Run your existing data transformation sub
            ' Save as Excel file (preserves original name, replaces extension with .xls)
            ActiveWorkbook.SaveAs Filename:=SaveToDirectory & _
                Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & ".xls", _
                FileFormat:=xlWorkbookNormal
            ActiveWorkbook.Close SaveChanges:=False
        Else
            MsgBox "Failed to process: " & vFileName, vbExclamation
            Err.Clear ' Reset error flag for next file
        End If
        On Error GoTo 0 ' Reset error handling to default
    Next vFileName
    
    MsgBox "Batch processing complete!", vbInformation
End Sub

Key Changes Explained: #

• Multi-file selection: Added MultiSelect:=True to GetOpenFilename so you can select dozens of files at once. The selected paths are stored in an array we loop through.
• Dynamic save directory: Added a folder picker dialog so you can choose where to save processed files—no more hardcoding SaveToDirectory!
• Error resilience: Added basic error handling to skip files that fail to open/process, with a message to alert you which files had issues.
• Clean filename handling: Adjusted the save logic to avoid messy double extensions (like file.txt.xls) by stripping the original extension before adding .xls.

Just make sure your existing Transform sub is still in the same module—this code relies on it to handle the actual data modifications you already wrote.

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