Default Outlook signature with VBA

[franzalvarado]

Hi,

I need to automatically add the default signature of outlook. I have come up with the below code by adding things as needed, however I am not an expert and things mess when I try something.

The current code does send the email to a specific address, with a confirmation pop-up window, using a specific range of cells, with specific summary. I need it sends the range of cells but adding the signature as any email.

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub Send_email()[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim AWorksheet AsWorksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim Sendrng AsRange[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim rng As Range[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error GoToStopMacro[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    With Application[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]       .ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        .EnableEvents= False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]Set Sendrng =Worksheets("EMAILING").Range("A5:M121")[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]MsgBox "Send?"[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]Set AWorksheet = ActiveSheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]With Sendrng[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    .Parent.Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Set rng =ActiveCell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    .Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]       ActiveWorkbook.EnvelopeVisible = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        With.Parent.MailEnvelope[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]            With .Item[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                .to ="Franz.Alvarado@us.fujitsu.com"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                .CC =""[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                .BCC =""[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               .Subject = "TEST" & Space(1) & Range("C11")& Space(1) & Date[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                .Send[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]            End With[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]        End With[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]        'select theoriginal ActiveCell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        rng.Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]    AWorksheet.Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]StopMacro:[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    With Application[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]       .ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        .EnableEvents= True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   ActiveWorkbook.EnvelopeVisible = False[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

Thanks in advance.

 

[James_Latimer]

It may be worth looking at this: https://www.mrexcel.com/forum/excel...k-signature-using-vba-when-sending-email.html