基于文件名变量循环导入文件的VBA实现求助

嘿，完全不用道歉！新手刚接触VBA摸不着头脑太正常了，我帮你把现有代码改成能循环处理多个文件、每次都导入到新工作表的版本～

核心思路 #

你的现有代码已经能完成单个文件的导入和格式设置，我们只需要添加几个关键步骤：

• 循环读取要处理的文件名（比如从单元格列表里逐个读取）
• 每次循环都新建一个空白工作表
• 在新工作表里执行你的导入和格式设置逻辑
• 避免依赖ActiveCell/ActiveSheet这类不稳定的对象，改用变量明确引用

修改后的完整代码 #

Sub LoadMultipleFiles()
    Dim fileName As String
    Dim folderPath As String
    Dim currentCell As Range
    Dim newSheet As Worksheet
    
    ' 设置你的文件存放路径，记得改成实际路径
    folderPath = "FILEPATH"
    
    ' 从当前选中的单元格开始读取文件名，直到遇到空单元格停止
    Set currentCell = ActiveCell
    
    Do While currentCell.Value <> ""
        fileName = currentCell.Value
        
        ' 新建一个工作表，放在最前面（可以改成After:=Sheets(Sheets.Count)放在最后）
        Set newSheet = ThisWorkbook.Sheets.Add(Before:=Sheets(1))
        ' 给新工作表命名为文件名（如果文件名合法的话）
        On Error Resume Next ' 处理文件名包含非法字符的情况
        newSheet.Name = Replace(fileName, ".txt", "")
        On Error GoTo 0
        
        ' 在新工作表的A1单元格开始导入文本文件
        With newSheet.QueryTables.Add( _
            Connection:="TEXT;" & folderPath & fileName, _
            Destination:=newSheet.Range("A1"))
            
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
        ' 应用字体格式到新工作表的所有单元格
        With newSheet.Cells.Font
            .Name = "Lucida Console"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        
        ' 设置新工作表的页面布局
        Application.PrintCommunication = False
        With newSheet.PageSetup
            .Orientation = xlLandscape
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
        End With
        Application.PrintCommunication = True
        
        ' 移动到下一个单元格，读取下一个文件名
        Set currentCell = currentCell.Offset(1, 0)
    Loop
    
    MsgBox "所有文件导入完成！", vbInformation
End Sub

关键修改说明 #

• 循环逻辑：用Do While循环读取单元格里的文件名，直到遇到空单元格停止，不用手动逐个执行
• 新建工作表：每次循环都创建新工作表，并用newSheet变量明确引用，避免依赖ActiveSheet导致的错误
• 移除不必要的Select：把原来的Cells.Select改成直接引用newSheet.Cells，让代码更稳定、高效
• 错误处理：给新工作表命名时加了简单的错误处理，避免文件名包含非法字符导致崩溃
• 完成提示：循环结束后弹出提示框，告诉你所有文件都处理完了

使用方法 #

1. 把代码里的folderPath = "FILEPATH"改成你的文本文件实际存放路径（比如"C:\MyTextFiles\"）
2. 在Excel里选中存放文件名的第一个单元格（比如A1，下面A2、A3分别是AB1.txt、AB2.txt等）
3. 运行这个宏，它会自动逐个导入每个文件到新工作表，并应用你设置好的格式

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