Word VBA 脚本：将图像添加到所有子文件夹中的 word 文档

Question

我正在尝试创建一个 VBA 脚本来执行以下操作：

1. 输入子文件夹（文件夹名称：101）
2. 打开word文档
3. 如果我放置了“书签”，则将图像添加到文档中（图像位于同一文件夹中）
4. 保存文档
5. 关闭文档
6. 重新输入下一个子文件夹（文件夹名称：102）并重新执行该过程，直到完成所有文件夹

文件夹结构如下：

Root folder: My Pictures

----
Subfolder: 101
----
File: test_document.docx
File: test_document – Copy.docx
File: test_document - Copy - Copy.docx
File: 6_Month_Assessment.jpg
File: portfolio.jpg
File: slide_deck.jpg

----
Subfolder:**102
----
File: test_document.docx
File: 6_Month_Assessment.jpg
File: portfolio.jpg
File: slide_deck.jpg

Etc. (up to 201 Subfolder)

请看下面我在这个网站上找到的一些代码（URL：VBA Macro replace text in Word file in all sub folders），并且在编译代码时尝试修改代码以满足我的需要，但没有任何反应。请注意，我是 VBA 脚本的新手。

   Sub DoLangesNow()
Dim file
Dim path As String
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant

     strFolder = "C:\My Pictures\"

     ' Loop through the subfolders and fill Collection object
     strSubFolder = Dir(strFolder & "*", vbDirectory)
     Do While Not strSubFolder = ""
         Select Case strSubFolder
             Case ".", ".."
                 ' Current folder or parent folder - ignore
             Case Else
                 ' Add to collection
                 colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
         End Select
         ' On to the next one
         strSubFolder = Dir
     Loop
     ' Loop through the collection
     For Each varItem In colSubFolders
         ' Loop through word docs in subfolder
         'YOU MUST EDIT THIS if you want to change the files extension
        strFile = Dir(strFolder & varItem & "\" & "*.docx")
         Do While strFile <> ""
         Set file = Documents.Open(FileName:=strFolder & _
                 varItem & "\" & strFile)

  ActiveDocument.Bookmarks("TEST").Range.InlineShapes.AddPicture FileName:=ThisDocument.path & "\Thrombolysis.jpg"
  ActiveDocument.Bookmarks("TEST2").Range.InlineShapes.AddPicture FileName:=ThisDocument.path & "\slide_deck.jpg"

' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
strFile = Dir
         Loop
     Next varItem
 End Sub

更新问题 (16/09/14 : 17:59) 我开始收到以下消息：“运行时错误 '5152”

Answer 1

我已通过更改以下代码行来解决此问题：

原始代码行：

ActiveDocument.Bookmarks("TEST").Range.InlineShapes.AddPicture FileName:=ThisDocument.path & "\images\Thrombolysis.jpg" ActiveDocument.Bookmarks("TEST2").Range.InlineShapes.AddPicture FileName:=ThisDocument.path & "\images\slide_deck.jpg"

新代码：

ActiveDocument.Bookmarks("TEST").Range.InlineShapes.AddPicture FileName:=ActiveDocument.path & "\Thrombolysis.jpg" ActiveDocument.Bookmarks("TEST2").Range.InlineShapes.AddPicture FileName:=ActiveDocument.path & "\slide_deck.jpg"