如何修改Word VBA代码批量导入TXT到Word且内容前标注对应文件名

调整逻辑 #

• 在每个TXT文件内容插入前，先写入对应文件名
• 优化原代码的TXT文件关闭参数，避免误修改原TXT文件
• 支持可选的文件名格式设置（如加粗、加自定义分隔符）

修改后完整代码 #

Sub A_Import_text()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, txtFile As Document
strFolder = GetFolder("")
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.txt", vbNormal)
Set wdDoc = ActiveDocument
While strFile <> ""
  Set txtFile = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ConfirmConversions:=False)
  ' 先插入文件名，可按需修改前后的换行数量、添加自定义分隔符
  wdDoc.Range.InsertAfter strFile & vbCrLf
  ' 可选：给文件名设置加粗格式，不需要可以删掉下面两行
  wdDoc.Paragraphs(wdDoc.Paragraphs.Count - 1).Range.Bold = True
  wdDoc.Range.InsertAfter vbCrLf
  ' 插入TXT文件内容
  wdDoc.Range.InsertAfter txtFile.Range.Text & vbCrLf & vbCrLf
  ' 原TXT文件仅读取无需保存，避免误改原文件
  txtFile.Close SaveChanges:=False
  strFile = Dir()
Wend
Set txtFile = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub


Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

可选自定义调整说明 #

• 若不需要文件名加粗，删除代码中注释标注的两行格式设置代码即可
• 可自定义文件名前后的分隔符，比如将strFile & vbCrLf修改为"===== " & strFile & " =====" & vbCrLf，增强不同文件内容的区分度
• 可调整换行符数量（vbCrLf）控制不同文件内容的间距

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