新しいメールアイテムにOutlookの署名を追加する

Question

コードに記載されている2つのセルから新しいメールを作成します。新しい電子メールには、電子メール署名が添付されていません。

私はそれを解決しようとしましたが、少し苦労しています。それはHTMLBodyの参照からそれを引き出すのですか？

Sub SendHTMLEmail(from_sender As String, what_address1 As String, cc_sender As String, subject_line1 As String, mail_body1 As String) 

     Dim olapp As Outlook.Application 
     Dim olmail As Outlook.MailItem 

     Set olapp = CreateObject("Outlook.Application") 
     Set olmail = olapp.CreateItem(olMailItem) 

     olmail.SentOnBehalfOfName = from_sender 
     olmail.To = what_address1 
     olmail.CC = cc_sender 
     olmail.Subject = subject_line1 
     olmail.HTMLBody = mail_body1 
     olmail.Display 

End Sub 

Sub SendHoldingEmail() 

     Dim EmailWordings As Excel.Worksheet 
     Dim row_number As Long 
     Dim from_sender As String, cc_sender As String, Email_Subject As String, full_name As String, mail_body_message As String 


     Set EmailWordings = ThisWorkbook.Sheets("EmailWordings") 

     row_number = 1 

     Do 
     DoEvents 

     row_number = row_number + 1 

     from_sender = "blah@hotmail.com" 
     cc_sender = "blah@hotmail.com" 
     mail_body_message = EmailWordings.Range("D3") 
     Email_Subject = EmailWordings.Range("B3") 

     Call SendHTMLEmail(from_sender, "", cc_sender, Email_Subject, mail_body_message) 

     Loop Until row_number = 2 


    End Sub 

Answer 1

HTMLbodyを設定するときは、必ず既存のHTMLbodyを末尾に追加してください。これには既存の署名が含まれています。

Sub SendEmail() 

    Dim OutlookApplication As Object, OutlookMail As Object 

    Set OutlookApplication = CreateObject("Outlook.Application") 
    Set OutlookMail = OutlookApplication.CreateItem(0) 
    With OutlookMail 
     .GetInspector 
     .HTMLBody = "Email Content" & .HTMLBody 
     .Display 
    End With 

End Sub