Question

我当前的vba代码会在电子邮件正文中发送一封包含此代码内容的电子邮件，并且我想对其进行更改，以便它将我在包含（Email）的隐藏工作表中包含的嵌入式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

这是我厌倦编写调用表的代码，但是不起作用

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

我不确定只显示与以前相同的电子邮件的嵌入式Word文档还需要什么呢？

Answer 1

谢谢大家的意见...我不知道这是不是正确的做法，但我找到了另一种方法来完成此任务，方法是将电子邮件另存为模板，然后调用它并用下面的代码...我只是希望对使用我的宏的人来说可以解决...如果您有任何其他建议，请告诉我，但目前已解决

    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

将Excel工作表中的嵌入式Word Doc发送为电子邮件正文

1 个答案: