電子郵件宏中的簽名

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

您需要實際從文件中獲取文本，而不是像現在一樣將filepath設置爲字符串。我建議是這樣的：

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 

來源：http://www.exceluser.com/excel_help/questions/vba_textcols.htm

然後，您可以簡單地在你的代碼中使用此：

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

Answer 3

你的變量sigstring字面上是文件的只是名字 - 你從不讀文件內容。 要閱讀此內容，請不要忘記聲明一個變量（在我的示例中爲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