将excel工作表中嵌入的Word文档作为电子邮件正文发送

我当前的vba代码发送一封电子邮件，邮件正文中包含该代码的内容，我想对其进行更改，以便它发送一个名为（电子邮件）的隐藏表单中的嵌入word文档，该表单包含一些图像和文本，以及在此宏中填写的用户表单中填写的文本

以下是我目前用于电子邮件的代码部分

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

strMsg=“你好，你好，你好

”&
欢迎！

”&_
“随附，您将发现：

”&_
“
欢迎演讲。
”&_
“
您的欢迎信
”&_
“
到您工作地点的方向”
”&_
“
第一天指南和日程安排。（请随身携带所有这些内容）
”
strMsg=strMsg&“
带上您的文件副本。
”
strMsg=strMsg&“您的雇佣日期是。请准时”&”_
“在工作地点（），在。

”&_
“提醒您，如果您迟到，您的雇佣日期可能会推迟”

”&_
“注释：
”&_
“
别忘了你的图片ID
”&_
“
如果您有任何问题，请拨打分机5280。”_
“一天24小时，一周7天

”&_
“如果您有任何问题，请告诉我。

”&_
“问候。
”&_
“”&Application.UserName&“
”&_
“
”
strMsg=替换（strMsg，“，strSite）
strMsg=替换（strMsg，“，strHireDate）
strMsg=Replace（strMsg，“，strsteaddress）
strMsg=替换（strMsg，“，strTime）
strMsg=替换（strMsg，“，strsteroom）
设置olApp=GetObject（“，“Outlook.Application”）
错误转到0
如果olApp什么都不是，那么
出错时继续下一步
设置olApp=CreateObject（“Outlook.Application”）
错误转到0
如果olApp什么都不是，那么
MsgBox“Outlook不可用！”
出口接头
如果结束
如果结束

下面是我试图编程调用工作表但不起作用的代码

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

带WB的

.工作表（“电子邮件”）。可见=真
.Worksheets（“电子邮件”）.Copy Before:=WB.Worksheets（WB.Worksheets.Count）
.工作表（“电子邮件”）.Visible=xlSheetVeryHidden
.工作表（“电子邮件（2）”）.Shapes（“objWordEmail”）.OLEFormat.Verb 2
出错时继续下一步
设置WordDoc=GetObject（，“Word.Application”）.ActiveDocument
如果错误号为0，则
呃，明白了
设置WordApp=CreateObject（“Word.Application”）
可见=False
设置WordDoc=GetObject（，“Word.Application”）.ActiveDocument
如果结束
用WordDoc
With.Content.Find
.Text=“”
.Replacement.Text=strHireDate
.Wrap=wdFindContinue
.Execute Replace:=wdReplaceAll
.Text=“”
.Replacement.Text=strTime
.Wrap=wdFindContinue
.Execute Replace:=wdReplaceAll
.Text=“”
.Replacement.Text=stristeroom
.Wrap=wdFindContinue
.Execute Replace:=wdReplaceAll
.Text=“”
.Replacement.Text=strContactPhoneText
.Wrap=wdFindContinue
.Execute Replace:=wdReplaceAll
以
以

---

我不确定我还需要什么才能只显示嵌入的word文档，它只是一直显示与以前相同的电子邮件？

谢谢大家的意见。。。我不知道这是否是正确的做法，但我找到了另一种方法，通过将电子邮件保存为模板，然后调用它并用以下代码填充它来完成此操作。。。我只是希望这对使用我的宏的人来说是可行的。。。如果你有任何其他建议，让我知道，但现在这个问题已经解决了

    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

Set olAppMsg1 = olApp.CreateItemFromTemplate("\\mypath\Onboarding Files\Confirmacion de ingreso.oft")
    With olAppMsg1
        .HTMLBody = Replace(.HTMLBody, "[ROOM]", strSiteRoom)
        .HTMLBody = Replace(.HTMLBody, "[HIREDATE]", strHireDate)
        .HTMLBody = Replace(.HTMLBody, "[HIRETIME]", strTime)
        .HTMLBody = Replace(.HTMLBody, "[CONTACTEXT]", strContactPhoneExt)
        .To = strEmpEmail
        .Importance = olImportanceHigh
        .Attachments.Add ("\\mypath\Onboarding Files\Aceptación de formatos en WD.PPTX")
        .Attachments.Add (pathSaveIDPass)
        .Attachments.Add (strZip)
        .Display

    End With