VBA for Outlook Email Signature

L

Luis_B

New Member
Joined
Oct 13, 2021
Messages
38
Office Version
  1. 365
Platform
  1. Windows
Hey guys,

I have a VBA that creates an email, attaches a PDF, adds a body message, and displays the email. This part works great but the code takes my email signature off and I am not sure how to keep or add the signature back. Could someone please help me. Any help is greatly appreciated. Below is the code that I'm using. Thank you.

saveLocation = "S:\"
attachmentName = "AI_2023_04.pdf"
Set EmailPDF = Worksheets("AI").Range("b1", Range("i11").End(xlDown).End(xlToRight))
Set EmailPDF = EmailPDF.Resize(EmailPDF.Rows.Count + 1)

'Email body
strbody = "Hello" & vbNewLine & vbNewLine & _
"Please see the attached commission statement for April. This month you will receive the direct deposit on 05/12/23. " & vbNewLine & _
" " & vbNewLine & _
"If you have any questions, please let me know." & vbNewLine & _
" " & vbNewLine & _
"Regards,"

EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=attachmentName
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
With EmailItem
.To = ""
.Subject = "Commission Statement"
.body = strbody
.Attachments.Add attachmentName
.Display
End With
Set EmailItem = Nothing
Set EmailApp = Nothing
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Hi @Luis_B
Thanks for posting on the forum.​

I don't know how your data is, but these lines cause me problems:​
Luis_B said:
Set EmailPDF = Worksheets("AI").Range("b1", Range("i11").End(xlDown).End(xlToRight))
Set EmailPDF = EmailPDF.Resize(EmailPDF.Rows.Count + 1)
Click to expand...

I adjusted them to this:​
VBA Code: 
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))

The code would look like this. With some improvements:​
VBA Code: 
Sub sendEmail()
  saveLocation = "S:\"
  attachmentName = "AI_2023_04.pdf"
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))
 
  'Email body
  strbody = "Hello" & vbNewLine & vbNewLine & _
    "Please see the attached commission statement for April. This month you will receive the direct deposit on 05/12/23. " & vbNewLine & _
    " " & vbNewLine & _
    "If you have any questions, please let me know." & vbNewLine & _
    " " & vbNewLine & _
    "Regards,"
 
  EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & attachmentName
  Set EmailApp = CreateObject("Outlook.application")
  Set EmailItem = EmailApp.CreateItem(0)
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add ThisWorkbook.Path & "\" & attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
  Set EmailItem = Nothing
  Set EmailApp = Nothing
End Sub

If the changes don't work for you, then just update this part of your code to put the signature.​
Change this:
Luis_B said:
With EmailItem
.To = ""
.Subject = "Commission Statement"
.body = strbody
.Attachments.Add attachmentName
.Display
End With
Click to expand...

To this:
VBA Code: 
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------


Note Code Tag:
In future please use code tags when posting code.​
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.​
 
Upvote 0
Solution
DanteAmor said:
Hi @Luis_B
Thanks for posting on the forum.​

I don't know how your data is, but these lines cause me problems:​


I adjusted them to this:​
VBA Code: 
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))

The code would look like this. With some improvements:​
VBA Code: 
Sub sendEmail()
  saveLocation = "S:\"
  attachmentName = "AI_2023_04.pdf"
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))
 
  'Email body
  strbody = "Hello" & vbNewLine & vbNewLine & _
    "Please see the attached commission statement for April. This month you will receive the direct deposit on 05/12/23. " & vbNewLine & _
    " " & vbNewLine & _
    "If you have any questions, please let me know." & vbNewLine & _
    " " & vbNewLine & _
    "Regards,"
 
  EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & attachmentName
  Set EmailApp = CreateObject("Outlook.application")
  Set EmailItem = EmailApp.CreateItem(0)
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add ThisWorkbook.Path & "\" & attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
  Set EmailItem = Nothing
  Set EmailApp = Nothing
End Sub

If the changes don't work for you, then just update this part of your code to put the signature.​
Change this:


To this:
VBA Code: 
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------


Note Code Tag:
In future please use code tags when posting code.​
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.​
Click to expand...
Hello Dante,

Thank you so much for your help. The code at the bottom adds the signature to the email just like I wanted. Thank you again. But it makes the entire memo to be in one line instead of four separate lines, please see below. Would you be able to help me with this?

1685724584517.png


I would rather it look like this below

1685724888628.png



I only changed this part of the code

With EmailItem
.To = ""
.Subject = "Commission Statement"
.Attachments.Add attachmentName
.Display
.HtmlBody = strbody & .HtmlBody
.Display
End With

Thank you,
 
Upvote 0
Use this:

VBA Code: 
Sub sendEmail()
  saveLocation = "S:\"
  attachmentName = "AI_2023_04.pdf"
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))
  
  'Email body
  strbody = "Hello" & "<br><br>" & _
    "Please see the attached commission statement for April. " & _
    "This month you will receive the direct deposit on 05/12/23. " & "<br><br>" & _
    "If you have any questions, please let me know. " & "<br><br>" & _
    "Regards,"
  
  EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & attachmentName
  Set EmailApp = CreateObject("Outlook.application")
  Set EmailItem = EmailApp.CreateItem(0)
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add ThisWorkbook.Path & "\" & attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
  Set EmailItem = Nothing
  Set EmailApp = Nothing
End Sub
 
Upvote 0
DanteAmor said:
Use this:

VBA Code: 
Sub sendEmail()
  saveLocation = "S:\"
  attachmentName = "AI_2023_04.pdf"
  Set EmailPDF = Worksheets("AI").Range("b1", Range("i1").End(xlDown))
 
  'Email body
  strbody = "Hello" & "<br><br>" & _
    "Please see the attached commission statement for April. " & _
    "This month you will receive the direct deposit on 05/12/23. " & "<br><br>" & _
    "If you have any questions, please let me know. " & "<br><br>" & _
    "Regards,"
 
  EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & attachmentName
  Set EmailApp = CreateObject("Outlook.application")
  Set EmailItem = EmailApp.CreateItem(0)
  With EmailItem
    .To = ""
    .Subject = "Commission Statement"
    .Attachments.Add ThisWorkbook.Path & "\" & attachmentName
    .Display
    .HtmlBody = strbody & .HtmlBody
    .Display
  End With
  Set EmailItem = Nothing
  Set EmailApp = Nothing
End Sub
Click to expand...
Amazing. That worked. Thank you so much. Have a great weekend.
 
Upvote 0
Hey Dante,

Sorry to bother you again. I'm getting an error when I change the name of the attachment and I don't understand why it doesn't like the name. The only thing that I am changing is the name of the PDF from AI_2023_04 to AI_2023_05. Only the last number changes. The code runs fine with the 4 at the end.

Below is the code and the error


Dim PDFrange As Range

With ActiveWorkbook

Set PDFrange = .Worksheets("AI").Range("b1", Range("i11").End(xlDown).End(xlToRight))
Set PDFrange = PDFrange.Resize(PDFrange.Rows.Count + 1)
PDFrange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.Path & "\AI_2023_05.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End With

saveLocation = "S:\Shared With Me\Luis\Commissions"
attachmentName = "AI_2023_05.pdf"
Set EmailPDF = Worksheets("AI").Range("b1", Range("i11").End(xlDown).End(xlToRight))
Set EmailPDF = EmailPDF.Resize(EmailPDF.Rows.Count + 1)

'Email body
strbody = "Hello," & "<br><br>" & _
"Please see the attached commission statement for May. " & _
"This month you will receive the direct deposit on 06/09/23. " & "<br><br>" & _
"If you have any questions, please let me know. " & "<br><br>" & _
"Regards,"

EmailPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=attachmentName
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
With EmailItem
.To = ""
.Subject = "Commission Statement"
.Display
.Attachments.Add attachmentName (The debug sends me here)
.HtmlBody = strbody & .HtmlBody
.Display
End With
Set EmailItem = Nothing
Set EmailApp = Nothing


Here is the error. I did not change the path at all.


1685825390076.png


Thank you again
 
Upvote 0
Dante,

Please ignore my question from above. I see now what I was doing wrong. I'm all good now. Thank you for all your help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
How can u resize the MBs in a image.
Replies
1
Views
181
NdNoviceHlp
NdNoviceHlp
E
  • Question Question
Trying to improve quality of image on Email.
Replies
0
Views
251
Eric Penfold
E
T
  • Question Question
VBA Error when Saving range to Pdf or trying to email range
Replies
1
Views
467
OaklandJim
O
O
  • Question Question
Add Signature to Email Macro
Replies
1
Views
293
starl
starl
S
  • Solved
Tweak to VBA email code
Replies
3
Views
719
rollis13
rollis13

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top