如何修改VBA代码实现按部分文件名匹配导入文本文件至当前工作簿指定工作表

嘿，刚好能帮你搞定这个需求！原来的Workbooks.Open方法确实会自动新建工作簿，要改成导入到当前活动工作簿的指定工作表，我们可以用QueryTables来直接完成导入操作，完全不需要额外创建工作簿。

修改后的完整代码 #

Sub ImportTextToSpecifiedSheet()
    Dim fp As String, fn As String
    Dim targetSheet As Worksheet
    Dim qt As QueryTable
    
    ' 设置文件路径和匹配规则，和你原来的逻辑保持一致
    fp = "C:\temp\"
    fn = "dog*"
    fn = Dir(fp & fn & "*.txt")
    
    ' 检查是否找到匹配的文本文件
    If CBool(Len(fn)) Then
        ' 指定目标工作表（把"ImportData"改成你实际需要的工作表名称即可）
        Set targetSheet = ThisWorkbook.Worksheets("ImportData")
        
        ' 可选：清空目标工作表原有数据，避免新旧数据混在一起
        targetSheet.Cells.Clear
        
        ' 创建查询表，直接把文本文件数据导入到目标工作表的A1单元格
        Set qt = targetSheet.QueryTables.Add( _
            Connection:="TEXT;" & fp & fn, _
            Destination:=targetSheet.Range("A1"))
        
        ' 配置导入参数，适配你的逗号分隔需求
        With qt
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True ' 启用逗号作为分隔符
            .TextFileColumnDataTypes = Array(xlTextFormat) ' 所有列按文本导入，防止格式自动转换出错
            .Refresh BackgroundQuery:=False ' 立即执行导入操作
            .Delete ' 导入完成后删除查询表，避免重复运行时出现冲突
        End With
        
        MsgBox "数据已成功导入到工作表：" & targetSheet.Name, vbInformation
    Else
        MsgBox "没找到匹配的文本文件哦！", vbExclamation
    End If
End Sub

关键修改细节说明 #

• 指定目标工作表：用ThisWorkbook.Worksheets("ImportData")锁定当前工作簿里的目标表，你可以把"ImportData"改成自己需要的表名；如果想直接导入到当前活动工作表，改成Set targetSheet = ActiveSheet就行。
• QueryTables核心逻辑：通过这个方法直接将文本数据映射到目标单元格，全程在当前工作簿内操作，不会新建额外文件。
• 参数适配：保留了你原来的逗号分隔需求，同时加了文本格式导入的设置，避免日期、长数字等内容被自动转换导致数据失真。

额外小提示 #

如果你的目标工作表还没创建，可以在代码里加一段自动创建的逻辑，放在Set targetSheet = ...之前即可：

' 检查目标工作表是否存在，不存在就自动新建
On Error Resume Next
Set targetSheet = ThisWorkbook.Worksheets("ImportData")
On Error GoTo 0
If targetSheet Is Nothing Then
    Set targetSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    targetSheet.Name = "ImportData"
End If

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