Question

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

输入子文件夹（文件夹名称：101）
打开word文档
如果我已经放置了“书签”（图像位于同一文件夹中）
保存文档
关闭文档
重新输入下一个子文件夹（文件夹名称：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 Scripting时是一个新手。

   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"

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

1 个答案: