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

来源：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

Answer 4

您可以通过输入项目.With语句后立即显示并在正文消息上添加.body来添加默认签名。参见下面的代码

使用OutMail

.Display
.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 &  .body
             "Looking forward to your response." & vbNewLine & vbNewLine & _
             "Many thanks." & vbNewLine & vbNewLine

电子邮件宏签名

4 个答案: