Макрос для отправки шаблона - PullRequest
0 голосов
/ 26 сентября 2018

У меня длинное письмо, которое мне нужно отправить нашим провайдерам с помощью макроса.Я попытался настроить электронную почту как функцию и затем вызвать функцию, но я достиг максимального числа возвратов каретки.

Я хотел бы сделать электронное письмо шаблоном, чтобы его было легче обновлять, а затем отправлять.Пока что у меня есть это, и оно работает для коротких сообщений, мое сообщение длинное, поэтому я думаю, что шаблон будет лучшим.

Sub Sample_Auto_Generated_Email()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

    Email_Subject = "Sample MAR Email"

    Email_Send_From = "Richard.Sabbara@x.com"

    Email_Send_To = "Richard.Sabbara@x.com"
    Set objOutl = CreateObject("Outlook.Application")
    Set objMailItem = objOutl.CreateItem(olMailItem)

    objMailItem.Display
    strEmailAddr = "Richard.Sabbara@x.com"
    objMailItem.Recipients.Add strEmailAddr
    objMailItem.Subject = "Sample"
    objMailItem.Body = GetMessageBody()  
    objMailItem.Send
    Set objMailItem = Nothing
    Set objOutl = Nothing

    End Sub

    ' This Function has been added.
    Function GetMessageBody() As String
    GetMessageBody = "Good Afternoon" & vbNewLine & _
    Chr(10) & _
    "Attached is your Monthly Action Report (MAR) for May 2018." & vbNewLine & _
    Chr(10) & _
    "This report has been password protected with your practice password provided         
    to you by your ACOP Care Coordinator in April 2018." & vbNewLine & _
    Chr(10) & _
    "Technical questions (such as, how to access the MAR, password issues, not 
    receiving the email, etc.), please contact the Physician Engagement team at 
    providerservices@ax.com."
    Chr (10) & _
    "Questions related to the patient data contained within the MAR, please `enter code here`
    contact your ACO Partner Care Coordinator."
    Chr (10) & _
    "Thank you,"
    End Function

1 Ответ

0 голосов
/ 26 сентября 2018

Вы можете создать документ с суффиксом с именем .docx, поместите свой шаблон в этот документ.

Замените ваш код на следующий код:

Sub Sample_Auto_Generated_Email()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem

    Set wd = CreateObject("Word.Application")
    Set doc = wd.documents.Open("D:\aa.docx")
    doc.Content.Copy
    doc.Close
    Set wd = Nothing
    Email_Subject = "Sample MAR Email"

    Email_Send_From = “"

    Email_Send_To = ""
    Set objOutl = CreateObject("Outlook.Application")
    Set objMailItem = objOutl.CreateItem(olMailItem)
    objMailItem.Display
    strEmailAddr = ""
    objMailItem.Recipients.Add strEmailAddr
    objMailItem.Subject = "Sample"
    objMailItem.BodyFormat = olFormatRichText
    Set editor = objMailItem.GetInspector.WordEditor
        editor.Content.Paste
    'objMailItem.HTMLBody =
    objMailItem.Send
    Set objMailItem = Nothing
    Set objOutl = Nothing

    End Sub

Это мой результат:

enter image description here

...