vba outlook signature with sender name

Question

I've searched for a lot of questions but I couldn't find something that matches what I'm trying to do.

I have this Outlook code to send my sheet called Pedidos via e-mail.

Sub Mail_ActiveSheet()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sCC As String
    Dim Signature As String

    sCC = Range("copia").Value
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    Sheets("Pedidos").Copy
    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
        If Val(Application.Version) < 12 Then
            ' For Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' For Excel 2007-2010, exit the subroutine if you answer
            ' NO in the security dialog that is displayed when you copy
            ' a sheet from an .xlsm file with macros disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered NO in the security dialog."
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With


    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Sourcewb.Sheets("Consulta").Range("F2:G2").Value & " " _
                 & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & Year(Now) & Hour(Now) & Minute(Now) & Second(Now)

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        On Error GoTo 0
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .to = "example@example.com"
            .CC = sCC
            .BCC = ""
            .Subject = "[PEDIDOS 019] " & TempFileName
            .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>"
            .HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & xxxxx & "</font>"
            .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
            .SEND
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

As you can see, the xxxxx in the line below represents my signature which I want to get my e-mail (as I'm sending) and write it there (or the name and lastname).

   .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>"
    .HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & xxxxx & "</font>"

So I really what this xxxxx to be my-email, or maybe my name, for example.

I've already checked the MailItem.SenderName property, but I didn't understand how to use it. This is my first time e-mailing using VBA so any suggestions will be highly appreciated.

will the user have a predefined signature set up in Outlook that always appears with new messages? — Scott Holtzman, Aug 04 '17 at 13:41
@ScottHoltzman no, the only signiature I want is the name or address of the sender — paulinhax, Aug 04 '17 at 14:05
see [this answer](https://stackoverflow.com/questions/26519325/how-to-get-the-email-address-of-the-current-logged-in-user) to learn how to grab the email or name of the current user. — Scott Holtzman, Aug 04 '17 at 15:14

score 1 · Answer 1 · answered Aug 04 '17 at 13:41

1

Try the below code this will work

.HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & .To & "</font>"

Just replace XXXXX by .To it will add that ".To" in your signature

answered Aug 04 '17 at 13:41

nishit dey

458
1
7
21

sorry I just realized that I mispelled my question. It should be my own e-mail instead `example@example.com`. If I have some property called `.From` maybe I can do the same. – paulinhax Aug 04 '17 at 14:08
trying with `.From` I got a TypeMismatch. – paulinhax Aug 04 '17 at 14:19
You need to add the code ".SentOnBehalfOfName = "email@email.com". You have to add it manually or give a reference from any excel sheet eg. ".SentOnBehalfOfName = Sheet1.cells(1,1)" – nishit dey Aug 04 '17 at 14:21
I see, but if different people access the sheet I can't insert a static e-mail as `.SentOnBehalfOfName = "email@email.com`... – paulinhax Aug 04 '17 at 14:23

score 1 · Accepted Answer · answered Aug 04 '17 at 15:55

SenderName will not be available until the mail is sent.

Option Explicit

Sub Signature_Insert()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim nS As Object

    Dim signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set nS = OutApp.GetNamespace("mapi")

    Debug.Print nS.CurrentUser
    Debug.Print nS.CurrentUser.name ' default property

    Debug.Print nS.CurrentUser.Address
    Debug.Print nS.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress

    signature = nS.CurrentUser
    'signature = nS.CurrentUser.Address

    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "example@example.com"
        .CC = "sCC"
        .BCC = ""
        .Subject = "[PEDIDOS 019] " & "TempFileName"
        .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>"
        .HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & signature & "</font>"
        .Display
    End With

ExitRoutine:
    Set OutApp = Nothing
    Set nS = Nothing
    Set OutMail = Nothing

End Sub

vba outlook signature with sender name

2 Answers2