Hi Guys,

Happy Friday!!! Hope everyone is doing great. I need your help with the following issue.

My current vba code sends an email with the content of this code in the body of the email and I want to change it so it sends the embedded word document I have in a hidden sheet called (Email) that has some images and text as well as text that gets filled in from the user-form. Can you please help me get this done. Here is the part of the code I'm currently using for the email.

Current email code:

strMsg = "<p>Hello Good Day</p></br>" & _        "<p>ˇWelcome!</p></br>" & _
        "<p><strong>Attached you will find:</strong></p></br>" & _
        "<ul><li>A welcome presentation.</li>" & _
        "<li>Your welcome letter</li>" & _
        "<li>Directions to you work location <SITE></li>" & _
        "<li>First day Guide and Agenda. (Please bring all of this with you)</li>"


strMsg = strMsg & "<li>Bring Copies of your documents.</li></ul>"


strMsg = strMsg & "<p>Your hire date is <strong><u><HIREDATE></u></strong>. Please be on time " & _
        "at the work location <SITE> (<ADDRESS>) at <strong><HIRETIME>, in <ROOM>.</strong></p></br>" & _
        "<p>Be reminded if you are late your hires date maybe pushed back</p></br>" & _
        "<p><strong>Notes</strong>:</p>" & _
        "<ul><li>Dont forget your picture ID</li>" & _
        "<li>If You have any questions please dial Ext <u>5280</u>." & _
        " 24 hours a day 7 days a week</li></ul></br>" & _
        "<p>Please let me know if you have any questions.</p></br>" & _
        "<p>Regards.</p>" & _
        "<p>" & Application.UserName & "</p>" & _
        "<p><a title='MYICON' target='_blank' rel='noopener'><img src='https://www.underconsideration.com/brandnew/archives/MYICON_logo_detail.png' width='157' height='85' /></a></p>"


strMsg = Replace(strMsg, "<SITE>", strSite)
strMsg = Replace(strMsg, "<HIREDATE>", strHireDate)
strMsg = Replace(strMsg, "<ADDRESS>", strSiteAddress)
strMsg = Replace(strMsg, "<HIRETIME>", strTime)
strMsg = Replace(strMsg, "<ROOM>", strSiteRoom)


   Set olApp = GetObject("", "Outlook.Application")
    On Error GoTo 0
    If olApp Is Nothing Then
        On Error Resume Next
        Set olApp = CreateObject("Outlook.Application")
        On Error GoTo 0
        If olApp Is Nothing Then
            MsgBox "Outlook is not available!"
            Exit Sub
        End If
    End If
This part will fill in the spaces on the embedded word document in the email sheet:

With WB


    .Worksheets("Email").Visible = True
    .Worksheets("Email").Copy Before:=WB.Worksheets(WB.Worksheets.Count)
    .Worksheets("Email").Visible = xlSheetVeryHidden
    .Worksheets("Email (2)").Shapes("objWordEmail").OLEFormat.Verb 2
               
On Error Resume Next
    Set WordDoc = GetObject(, "Word.Application").ActiveDocument


If Err.Number <> 0 Then
        Err.Clear
        Set WordApp = CreateObject("Word.Application")
        WordApp.Visible = False
        Set WordDoc = GetObject(, "Word.Application").ActiveDocument
End If
     
    With WordDoc
        With .Content.Find
        .Text = "<HIREDATE>"
        .Replacement.Text = strHireDate
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        
        .Text = "<HIRETIME>"
        .Replacement.Text = strTime
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        
        .Text = "<ROOM>"
        .Replacement.Text = strSiteRoom
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        
        .Text = "<CONTACTEXT>"
        .Replacement.Text = strContactPhoneExt
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
        
    End With
End With