Проблема отправки электронной почты Outlook из Excel VBA при использовании шаблона - PullRequest
Новая
       6

Проблема отправки электронной почты Outlook из Excel VBA при использовании шаблона

0 голосов
/ 27 ноября 2018

У меня есть готовый шаблон 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

Где я ошибаюсь?

...