title: Creating Word Docs w/ Excel VBA- Insert Images? Copy and Paste Text from 3rd Doc
body: <p>I am trying to write some VBA code in excel to automate my task of building 100+ .pdf word documents, each following the set template. I originally copied a code from a youtube <a href="https://www.youtube.com/watch?v=URF3ikW0Svc" rel="nofollow noreferrer">tutorial</a> showing how to build automated emails from a spreadsheet, and I felt my application was similar enough. </p>
  
  <p>I can get the text replacements to occur as they should. My primary issue is getting images inserted where they need to be. I've attempted using a bookmark and replace code with no luck. I think my issue lies in my variables not having the correct value between the various subs, although that is only my uneducated best guess.</p>
  
  <p>My next issue is creating a code to pull text from an existing document and paste into a new document. I'll be honest, I have been so stuck on the image issue that I haven't even looked into this yet.</p>
  
  <p>I may be going about this task in an inefficient way, however, if someone may be able to spot the fault in my code, it would be greatly appreciated. I have pasted my existing code below. Hopefully it isn't too bad.</p>
  
  <pre><code>    Option Explicit
  
     Dim CustRow, CustCol, LastRow, TemplRow, j  As Long
     Dim DocLoc, TagName, TagValue, TemplName, FileName As String
     Dim CurDt, LastAppDt As Date
     Dim WordDoc, WordApp As Object
     Dim WordContent As Word.Range
  
  Sub CreateWordDocuments()
  
  With Sheet1
  
    If .Range("B3").Value = Empty Then
      MsgBox "Please select a correct template from the drop down list"
      .Range("G3").Select
      Exit Sub
    End If
      TemplRow = .Range("B3").Value 'Set Template Row
      TemplName = .Range("G3").Value 'Set Template Name
      DocLoc = Sheet2.Range("F" &amp; TemplRow).Value 'Word Document Filename
  
      'Open Word Template
      On Error Resume Next 'If Word is already running
      Set WordApp = GetObject("Word.Application")
          If Err.Number &lt;&gt; 0 Then
          'Launch a new instance of Word
          Err.Clear
          'On Error GoTo Error_Handler
          Set WordApp = CreateObject("Word.Application")
          WordApp.Visible = True 'Make the application visible to the user
          End If
  
  
      LastRow = .Range("E9999").End(xlUp).Row  'Determine Last Row in Table
          For CustRow = 8 To LastRow
                                  Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
                                  For CustCol = 5 To 10 'Move Through 6 Columns
                                      TagName = .Cells(7, CustCol).Value 'Tag Name
                                      TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                                       With WordDoc.Content.Find
                                          .Text = TagName
                                          .Replacement.Text = TagValue
                                          .Wrap = wdFindContinue
                                          .Execute Replace:=wdReplaceAll 'Find &amp; Replace all instances
                                       End With
                                   Next CustCol
  
           Call InsertScreenshots
  
      If .Range("I3").Value = "PDF" Then
                                            FileName = ThisWorkbook.Path &amp; "\" &amp; .Range("E" &amp; CustRow).Value &amp; "_" &amp; .Range("G" &amp; CustRow).Value &amp; ".pdf" 'Create full filename &amp; Path with current workbook location, Category_Model
                                            WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
                                            WordDoc.Close False
                                        Else: 'If Word
                                            FileName = ThisWorkbook.Path &amp; "\" &amp; .Range("E" &amp; CustRow).Value &amp; "_" &amp; .Range("G" &amp; CustRow).Value &amp; ".docx"
                                            WordDoc.SaveAs FileName
                                     End If
                                        .Range("O" &amp; CustRow).Value = TemplName 'Template Name
                                        .Range("P" &amp; CustRow).Value = Now
       Next CustRow
  
  
  End With
  
  
  End Sub
  
  
   Sub FillABookmark(bookmarkname As String, imagepath As String)
  
     Dim objWord As Object
      Dim objDoc As Object
      With Sheet1
  
      On Error Resume Next
      Set objWord = GetObject(, "Word.Application")
      If objWord Is Nothing Then
          Set objWord = CreateObject("Word.Application")
          objWord.Visible = True
          objWord.Documents.Open "DocLoc"
      End If
  
      Set objDoc = objWord.ActiveDocument
  
      With objDoc
          .Bookmarks(bookmarkname).Select
          .Shapes.AddPicture FileName:=imagepath
      End With
  End With
  End Sub
  
  Sub InsertScreenshots()
      With Sheet1
          For CustCol = 11 To 14 'Move Through 4 Columns
              TagName = .Cells(7, CustCol).Value 'Tag Name
              TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                      Call FillABookmark("TagName", "TagValue")
           Next CustCol
      End With
  
  End Sub
  </code></pre>