電子メールマクロの署名

Question

自動メールを送信する際にデフォルトの署名を利用しようとしていますが、コードを修正できる方法はありますか？私のコードは、署名自体ではなく、署名の場所を貼り付けることになります。お知らせ下さい。

Sub CreateEmailForGTB() 

    Dim wb As Workbook 

    Set wb = Workbooks.Add 
    ThisWorkbook.Sheets("BBC").Copy After:=wb.Sheets(1) 

    'save the new workbook in a dummy folder 
    wb.SaveAs "location.xlsx" 

    'close the workbook 
    ActiveWorkbook.Close 

    'open email 
Dim OutApp As Object 
Dim OutMail As Object 
Dim newDate: newDate = Format(DateAdd("M", -1, Now), "MMMM") 
Dim sigstring As String 


Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

sigstring = Environ("appdata") & _ 
       "\Microsoft\Signatures\zbc.htm" 


    'fill out email 
With OutMail 
    .To = "abc@domain.com;" 
     .CC = "xyz@domain.com;" 
     .BCC = "" 
     .Subject = "VCR - CVs for BBC " & "- " & newDate & " month end." 
     .Body = "Hi all," & vbNewLine & vbNewLine & _ 
       "Please fill out the attached file for " & newDate & " month end." & vbNewLine & vbNewLine & _ 
       "Looking forward to your response." & vbNewLine & vbNewLine & _ 
       "Many thanks." & vbNewLine & vbNewLine & _ 
       sigstring 

Answer 1

私の意見では使いやすい電子メールメッセージに署名を表示する別の方法があります。デフォルトでは、新しいメッセージに表示するように署名を設定する必要があります。

実装方法については、以下で設定したルーチンを参照してください。

Sub SendMail(strTo As String, strSubject As String, strBody As String, strAttachments As String, Optional strCC As String, Optional strFolder As String, Optional blSend As Boolean) 

'******************************************************************* 
'** Sub:   SendMail 
'** Purpose:  Prepares email to be sent 
'** Notes:  Requires declaration of Outlook.Application outside of sub-routine 
'**     Passes file name and folder for attachments separately 
'**     strAttachments is a "|" separated list of attachment paths 
'******************************************************************* 

'first check if outlook is running and if not open it 
Dim olApp As Outlook.Application 

On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
On Error GoTo 0 
If olApp Is Nothing Then Set olApp = New Outlook.Application 

Dim olNS As Outlook.Namespace 
Dim oMail As Outlook.MailItem 

'login to outlook 
Set olNS = olApp.GetNamespace("MAPI") 
olNS.Logon 

'create mail item 
Set oMail = olApp.CreateItem(olMailItem) 

'display mail to get signature 
With oMail 
    .display 
End With 

Dim strSig As String 
strSig = oMail.HTMLBody 

'build mail and send 
With oMail 

    .To = strTo 
    .CC = strCC 
    .Subject = strSubject 
    .HTMLBody = strBody & strSig 

    Dim strAttach() As String, x As Integer 
    strAttach() = Split(strAttachments, "|") 

    For x = LBound(strAttach()) To UBound(strAttach()) 
     If FileExists(strFolder & strAttach(x)) Then .Attachments.Add strFolder & strAttach(x) 
    Next 

    .display 
    If blSend Then .send 

End With 

Set olNS = Nothing 
Set oMail = Nothing 

End Sub 

Answer 2

ファイルパスを文字列として設定するのではなく、実際にファイルからテキストを取得する必要があります。私はこのようなものをお勧めしたい：

Function GetText(sFile As String) As String 

   Dim nSourceFile As Integer, sText As String 

   ''Close any open text files 
   Close 

   ''Get the number of the next free text file 
   nSourceFile = FreeFile 

   ''Write the entire file to sText 
   Open sFile For Input As #nSourceFile 
   sText = Input$(LOF(1), 1) 
   Close 

   GetText = sText 

End Function 

出典：

sigstring = GetText(Environ("appdata") & "\Microsoft\Signatures\zbc.htm") 

Answer 3

あなたの変数sigstringは、文字通りファイルの名前だけです：あなたは、単にあなたのコードでこれを使用することができますhttp://www.exceluser.com/excel_help/questions/vba_textcols.htm

- あなたは決してファイルの内容を読むことができません。 内容を読むには、これを試してください（そして、私の例ではtextとlineという変数を宣言してファイルの内容を保持することを忘れないでください）。

sigstring = Environ("appdata") & "\Microsoft\Signatures\zbc.htm" 
Open sigstring For Input As #1 
Do Until EOF(1) 
    Line Input #1, line 
    text = text & line 
Loop 
Close #1