CODEWITHSUNDEEP
excelvba
wasimakram101
wasimakram101

Reputation: 103

Add signature to email

I'm trying to utilize my default signature when I send an automated email.

My code pastes the location of the signature rather than the signature itself.

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 = "[email protected];"
        .CC = "[email protected];"
        .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

Upvotes: 2

Views: 3044

Answers (4)

Armando Mercado
Armando Mercado

Reputation: 1

You can add your default signature by entering the items .Display right after your With statements and adding .body on the body message. see below code

With OutMail

.Display
.To = "[email protected];"
     .CC = "[email protected];"
    .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

Upvotes: 0

Scott Holtzman
Scott Holtzman

Reputation: 27259

There's another way to grab to display the signature in a email message, that in easier to use in my opinion. It does require that you have set up your signature to display on new messages by default.

See the routine I have set up below for how to implement.

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

Upvotes: 1

christophano
christophano

Reputation: 935

Your variable sigstring literally is just the name of the file - you never read the file contents. To read the contents try this (and don't forget to declare a variable (text and line in my example) to hold the file contents).

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

Upvotes: 0

Jordan
Jordan

Reputation: 4514

You need to actually get the text from the file as opposed to just setting the filepath as a string like you are now. I'd suggest something like this:

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

Source: http://www.exceluser.com/excel_help/questions/vba_textcols.htm

You can then simply use this in your code:

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

Upvotes: 0

Related Questions