title: Word VBA Script: adding images to a word document in all sub folders
body: <p>I am trying to create a VBA script that will do the following: </p>
  
  <ol>
  <li>Enter a subfolder  (name of folder: 101)</li>
  <li>Open the word document</li>
  <li>Add image to the document were I have placed the “bookmarks” (images are in the same folder)</li>
  <li>Save the document</li>
  <li>Close the document</li>
  <li>Re-enter the next subfolder (name of folder: 102) and re-doing the process until all folder are done</li>
  </ol>
  
  <p>Folder structure as follows:</p>
  
  <pre><code>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)
  </code></pre>
  
  <p>Please see bellow some code I have found on this site (URL: <a href="https://stackoverflow.com/questions/16908344/vba-macro-replace-text-in-word-file-in-all-sub-folders">VBA Macro replace text in Word file in all sub folders</a> ) and have tried to modify the code to meet my needs when compiling the code nothing happens. Please note I am a novice when come to VBA Scripting.</p>
  
  <pre><code>   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 &amp; "*", 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 &amp; varItem &amp; "\" &amp; "*.docx")
           Do While strFile &lt;&gt; ""
           Set file = Documents.Open(FileName:=strFolder &amp; _
                   varItem &amp; "\" &amp; strFile)
  
    ActiveDocument.Bookmarks("TEST").Range.InlineShapes.AddPicture FileName:=ThisDocument.path &amp; "\Thrombolysis.jpg"
    ActiveDocument.Bookmarks("TEST2").Range.InlineShapes.AddPicture FileName:=ThisDocument.path &amp; "\slide_deck.jpg"
  
  ' Saves the file
  ActiveDocument.Save
  ActiveDocument.Close
  ' set file to next in Dir
  strFile = Dir
           Loop
       Next varItem
   End Sub
  </code></pre>
  
  <p>Update issue (16/09/14 : 17:59) I have started to receive saying the following: "Run-time error '5152" </p>