电子邮件宏中的签名

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