Question

我有一个预制的Outlook模板，只需单击一下按钮即可自动填充并发送。

我尝试了这段代码的几次迭代，其中我尝试使用GetInspector函数等以及.HTMLBody = replace(....方法替换模板中的文本。

仅当我在发送前使用.display函数时，下面的代码才有效。如果我删除.display，则电子邮件将发送，但仅包含我已复制的空白模板。

Public Sub SendRequests()

Dim ReqType As String
Dim MouldNPE As String
Dim Rev As String
Dim Cust As String
Dim CustCon As String
Dim CustEm As String
Dim Country As String
Dim PLPs As String
Dim Notes As String

'open loading bar
LoadingBar.Show vbModeless

'determine how many new requests have been added
NumNewReqs = UBound(RequestsToSend_Type) - LBound(RequestsToSend_Type)

'set loading bar parameters
LoadingBarMaxWidth = 350
If NumNewReqs = 0 Then LoadingBarDivisor = 1 Else LoadingBarDivisor = NumNewReqs
LoadingBarIncrement = LoadingBarMaxWidth / LoadingBarDivisor

'loop through all new requests
For i = 0 To NumNewReqs
    'make sure outlook is open
    On Error Resume Next
    Set OLApp = GetObject(, "Outlook.Application")

    If OLApp Is Nothing Then
        Shell ("OUTLOOK")
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.ActiveWindow.WindowState = olMinimized
    Else
        Set OutApp = CreateObject("Outlook.Application")
    End If

    'extract mould number and rev for email subject
    MouldNPENum = RequestsToSend_MouldNPE(i) 'mould/npe number
    Rev = RequestsToSend_Rev(i) 'revision

    'open template
'    Set TempMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\RequestTemplate.oft")
'
'    'copy body of template and close
'    With TempMail
'        NewReqHTMLBody = .HTMLBody
'        .Close 1
'    End With
'
'    Set TempMail = Nothing

    'create new email
    Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\RequestTemplate.oft") 'OutApp.CreateItem(0)

    With OutMail
        .To = "ewan.otoole@stoelzle.com"
        .CC = ""
        .BCC = ""
        .Subject = "New Pack Spec Request - " & MouldNPENum & " " & Rev

        'open inspecor
        Set vInspector = OutMail.GetInspector
        Set wEditor = vInspector.WordEditor

        'add request data
        With wEditor
            .Bookmarks("ReqType").Range.Text = RequestsToSend_Type(i) 'request type
            .Bookmarks("MouldNPE").Range.Text = RequestsToSend_MouldNPE(i) 'mould/npe number
            .Bookmarks("Rev").Range.Text = RequestsToSend_Rev(i) 'revision
            .Bookmarks("Cust").Range.Text = RequestsToSend_Cust(i) 'customer
            .Bookmarks("CustCon").Range.Text = RequestsToSend_CustCon(i) 'customer contact
            .Bookmarks("CustEm").Range.Text = RequestsToSend_CustEma(i) 'customer email
            .Bookmarks("Country").Range.Text = RequestsToSend_Country(i) 'country

            If RequestsToSend_PLPs(i) = False Then PLPs = "No" Else PLPs = "Yes" 'plps
            Bookmarks("PLPs").Range.Text = PLPs
            Bookmarks("Notes").Range.Text = RequestsToSend_Notes(i)  'notes
        End With
        .Display
        .Send
    End With

    Set vInspector = Nothing
    Set wEditor = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing

    'increase loading bar size
    LoadingBar.LoadingBar.Width = LoadingBar.LoadingBar.Width + LoadingBarIncrement
Next i

'save workbook
ThisWorkbook.Save

'hide loading bar
Unload LoadingBar

Application.ScreenUpdating = True

'notify user
MsgBox "All requests have been sent!", vbInformation, "Pack Spec Requests"

End Sub

我要去哪里错了？

使用模板时从Excel VBA发送Outlook电子邮件时出现问题

0 个答案: