title: Excel vba code keeps running
body: <p>I have this code that opens a Word Template from Excel and paste in values to bookmarks in the Word Template. The code runs fine, but every now and then the codes runs 6 times in a row. This I know because I have a prompt that stops the code so it is possible to edit the word document before sending it. Sometimes the prompt pops up 6 times in a single run.
  I think it has something to do with my error handling in the start of the code, see below. The code needs to be able to run both if word is running or not. Thanks in advance for taking time to look at this.</p>
  
  <pre><code>Dim objWord As Object
  
  On Error Resume Next
     Set objWord = GetObject(, "Word.Application")
  If objWord Is Nothing Then
     Set objWord = CreateObject("Word.Application")
  End If
  
  On Error Resume Next
  If objWord = 0 Then
  Call WTWord
  End If
  </code></pre>
  
  <p>This is the full code, that reference to functions and scripts made by Ron de Bruin <a href="http://www.rondebruin.nl/" rel="nofollow noreferrer">http://www.rondebruin.nl/</a></p>
  
  <pre><code>Sub WTWord()
  
  Dim objWord As Object
  Dim objDoc As Object
  Dim objSelection As Object
  Dim wb As Workbook
      Dim FileName As String
      Dim FolderName As String
      Dim Folderstring As String
      Dim FilePathName As String
      Dim strbody As String
  
  If CheckAppleScriptTaskExcelScriptFile(ScriptFileName:="RDBMacOutlook.scpt") = False Then
          MsgBox "Sorry the RDBMacOutlook.scpt is not in the correct location"
          Exit Sub
  End If
  
  On Error Resume Next
     Set objWord = GetObject(, "Word.Application")
  If objWord Is Nothing Then
     Set objWord = CreateObject("Word.Application")
  End If
  
  objWord.Visible = False
  objDoc.Visible = False
  objSelection.Visible = False
  
  On Error Resume Next
  If objWord = 0 Then
  Call WTWord
  End If
  
  Set objDoc = objWord.Documents.Add("KONTRAKT.dotx")
  
     Set objSelection = objWord.Selection
  
  Dim Navn As Excel.Range
  Dim Adresse As Excel.Range
  
      FolderName = "PDFSaveFolder"
      FileName = objDoc.Name &amp; " " &amp; Format(Now, "dd-mmm-yyyy") &amp; ".pdf"
  
      Folderstring = CreateFolderinMacOffice2016(NameFolder:=FolderName)
      FilePathName = Folderstring &amp; Application.PathSeparator &amp; FileName
  
  Set Navn = Sheets("Sheet1").Range("A1")
  Set Adresse = Sheets("Sheet1").Range("A2")
  
  With objDoc.Bookmarks
  .Item("NAVN1").Range.InsertAfter Navn
  .Item("ADRESSE1").Range.InsertAfter Adresse
  End With
  
  Dim YN As String
  Dim Que As String
  
  Que = "Vil du tilføje eller ændre noget i kontrakten?"
  ThisWorkbook.Activate
  
  YN = MsgBox(Que, vbYesNo, "KONTRAKT")
  
  If YN = vbYes Then
  
  Word.Application.Activate
  
  Set objWord = Nothing
  Set objDoc = Nothing
  Set objSelections = Nothing
  
  Exit Sub
  
  Else
  
  objDoc.SaveAs2 FilePathName, 17
  
  objDoc.Close saveChanges:=False
  objWord.Quit
  
      strbody = "&lt;FONT size=""3"" face=""Calibri""&gt;"
  
      strbody = strbody &amp; "Hi there" &amp; "&lt;br&gt;" &amp; "&lt;br&gt;" &amp; _
       "This is line 1" &amp; "&lt;br&gt;" &amp; _
          "This is line 2" &amp; "&lt;br&gt;" &amp; _
          "This is line 3" &amp; "&lt;br&gt;" &amp; _
          "This is line 4"
  
      strbody = strbody &amp; "&lt;/FONT&gt;"
  
      MacExcel2016WithMacOutlookPDF _
      subject:="This is a test macro to mail the Activesheet as PDF", _
      mailbody:=strbody, _
      toaddress:="test@gmail.com", _
      ccaddress:="", _
      bccaddress:="", _
      displaymail:="yes", _
      accounttype:="", _
      accountname:="", _
      attachment:=FilePathName
  
  End If
  Exit Sub
  
  Set objWord = Nothing
  Set objDoc = Nothing
  Set objSelections = Nothing
  
  End Sub
  </code></pre>