VBA Word Merge and Email Help

Hello,

I have the below code that work in the sense that it will pull the document and create an email. However it will not word merge before the email is created so all the info that normally would be filled in is missing. How do I get it to mail merge successfully and then copy the data to the email. My word templates do not have pictures but they do have color and formatting. I have read a few different post but I don't think they are in reference to the goal that I am aiming for. Any help is appreciated.

Code:

---

Private Sub Combo1141_Click()
Dim dbHR As DAO.Database
Dim rstMerg As DAO.Recordset
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
'ADD INFO TO MERGE TABLE
DoCmd.OpenQuery "Delete_Temp_Table"
      Set dbsHR = CurrentDb
  Set rstMerg = dbsHR.OpenRecordset("Temp_Table")
rstMerg.AddNew
  rstMerg!Candidate_Name = Me.Candidate_Name
  rstMerg!Tentative_Start_Date = Me.Tentative_Start_Date
  rstMerg!Reporting_Manager = Me.Reporting_Manager
  rstMerg.Update
'WORD DOCUMENT OPENING
Set wd = CreateObject("Word.Application")
    Set doc = wd.Documents.Open("U:\Operations\Database\Mail Merg\First Day Details (Contractor).docx", ReadOnly)
    doc.Content.Copy
    doc.Close
    Set wd = Nothing
'Email Opening and create
Set OutApp = CreateObject("Outlook.Application")
    Set oMail = OutApp.CreateItem(0)
    With oMail
        .BodyFormat = olFormatRichText
        .Display
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
End With
End Sub

---

Thank you again for any help
Kris C.

you add a Bookmark to to your Word Template and fill the value from your Form.

Code:

---

Private Sub Combo1141_Click()
    'Dim dbHR As DAO.Database
    'Dim rstMerg As DAO.Recordset
    Dim wd As Object, editor As Object
    Dim doc As Object
    Dim oMail As MailItem
   
   
    'ADD INFO TO MERGE TABLE
   
'    DoCmd.OpenQuery "Delete_Temp_Table"
'    Set dbsHR = CurrentDb
'    Set rstMerg = dbsHR.OpenRecordset("Temp_Table")
'
'
'    rstMerg.AddNew
'    rstMerg!Candidate_Name = Me.Candidate_Name
'    rstMerg!Tentative_Start_Date = Me.Tentative_Start_Date
'    rstMerg!Reporting_Manager = Me.Reporting_Manager
'    rstMerg.Update
   
'arnelgp
'add bookmark on your word document to hold:
'
'Candidate_Name
'Tentative_Date
'Reporting_Manager
'
'then you open the Template and save it to temp document
'anywhere in your pc.
'
'copy the template (code)
Dim sDoc As String
sDoc = Environ$("Temp") & "\tmpMM.docx"
'delete temp file if already exists
If Dir$(sDoc) <> "" Then Kill sDoc
'now copy it
VBA.FileCopy "U:\Operations\Database\Mail Merg\First Day Details (Contractor).docx", sDoc
'open the temp docx
Set wd = CreateObject("Word.Application")
Set doc = wd.Documents.Open(sDoc)
'fill the Bookmark of this document
 With objwd.Selection
    .Goto WHAT:=wdGoToBookmark, Name:="Candidate_Name"
    .TypeText Text:=Me!Candidate_Name & ""
    .Goto WHAT:=wdGoToBookmark, Name:="Tentative_Date"
    .TypeText Text:=Me!Tentative_Start_Date & ""
    .Goto WHAT:=wdGoToBookmark, Name:="Reporting_Manager"
    .TypeText Text:=Me!Reporting_Manager & ""
End With
'save the document, coy content and close
With doc
    .Save
    .Content.Copy
    .Close
End With
Set wd = Nothing


'    'WORD DOCUMENT OPENING
'
'
'    Set wd = CreateObject("Word.Application")
'    Set doc = wd.Documents.Open("U:\Operations\Database\Mail Merg\First Day Details (Contractor).docx", ReadOnly)
'    doc.Content.Copy
'    doc.Close
'    Set wd = Nothing
   
   
    'Email Opening and create
   
   
    Set OutApp = CreateObject("Outlook.Application")
    Set oMail = OutApp.CreateItem(0)
    With oMail
        .BodyFormat = olFormatRichText
        .Display
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
   
    End With
End Sub

---

Hello arnelgo,

I have set bookmarks in the document. However when I run the code I get "Object required at "With objwd.selection" I think this is due to not dim objwd as an object, what would I dim it... I also get a message if I run the code again that says "permission needed" when it gets to "If Dir$(sDoc) <> "" Then Kill sDoc" Any suggestions on how to get around that?

Thank you for the your time and apologies for the late response.
kdc900

replace:

objwd.selection

with:

doc.selection


if you can't save to "temp" folder, save it to Documents folder:

sDoc = Environ$("UserProfile") & "\Documents\tmpMM.docx"

You may find https://www.gmayor.com/email_merge_addin.html useful.

I am not sure why, i cant post right now

Ok, I think its the photos that are not working when I post.

Hello

I am sorry for the late reply. Work has gotten crazy and has been hard to get time to work on the code.

I am getting an error at the "with doc.selection" point below due to "Object doesn't support this property or method"

Code:

---

Set doc = wd.Documents.Open(sDoc)
'fill the Bookmark of this document
 With doc.Selection
    .Goto WHAT:=wdGoToBookmark, Name:="Tentative_Date"
    .TypeText Text:=Me!Tentative_Start_Date & ""
    .Goto WHAT:=wdGoToBookmark, Name:="Reporting_Manager"
    .TypeText Text:=Me!Reporting_Manager & ""
End With

---

I am also having issues with the kill code and getting the message permission denied. Funny thing though is if got to the folder where the document is I can delete it my self.

Thank you for your help
Kris C.