How to include my email signature in VBA

R

Ramadan

Board Regular
Joined
Jan 20, 2024
Messages
98
Office Version
  1. 2021
Platform
  1. Windows
I have found a code on the web to send excel file as attachment and modified it to settle my needs
but I need your professional help to add my signature image to the email body and to make the email body text to be set as (Right to Left)
here is my code and screenshot of my email signature
need your suggestions please

VBA Code: 
[Sub sendfile()
Dim eapp As Object
Set eapp = CreateObject("outlook.application")

Dim eitem As Object
Set eitem = eapp.createitem(0)

fileNo = Range("B1")
Filename = Range("B2")
body = ("E5")
body2 = Range("E6")
body3 = Range("E7")
body4 = Range("E8")

Path = "D:\Desktop\Docs\booking list.xlsm\"
fname = Filename & " - " & fileNo

With eitem
    .to = Range("B3")
    .cc = Range("b4")
    .Subject = Filename & fileNo
    .body = "Dear All " _
    & vbCrLf _
    & vbCrLf _
    & body2 & fileNo _
    & vbCrLf _
    & vbCrLf _
    & body3 _
    & vbCrLf _
    & vbCrLf _
    & body4 _
    
    .Attachments.Add "D:\Desktop\Guards\gurads list.xlsm"
         
    .Send

End With
End Sub]

[ATTACH type="full"]121895[/ATTACH]
 

Attachments

  • SIGN.jpg
    SIGN.jpg
    15.5 KB · Views: 11

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
The following has been tested and works here. It requires the user to have Outlook installed on their computer. They DO NOT need to
have internet access ... the code only uses the Schema imbedded in Outlook.

VBA Code: 
Sub sendfile()
    Dim eapp As Object
    Set eapp = CreateObject("Outlook.Application")
    Dim eitem As Object
    Dim fileNo As Long
    Dim Filename As String
    Dim fname As String
    Dim Path As String
    Dim body As String, body2 As String, body3 As String, body4 As String
    Dim imgPath As String
    Dim imgAttachment As Object

    Set eitem = eapp.CreateItem(0)
    fileNo = Range("B1").Value
    Filename = Range("B2").Value
    body = Range("E5").Value
    body2 = Range("E6").Value
    body3 = Range("E7").Value
    body4 = Range("E8").Value

    Path = "C:\Users\logit\OneDrive\Desktop\booking list.xlsm"
    fname = Filename & " - " & fileNo

    imgPath = "C:\Users\logit\OneDrive\Desktop\Sign.jpg"

    With eitem
        .To = Range("B3").Value
        .CC = Range("B4").Value
        .Subject = Filename & fileNo
        .BodyFormat = 2 ' Set to HTML format
        .HTMLBody = "<html><body>Dear All,<br><br>" & _
            body2 & fileNo & "<br><br>" & _
            body3 & "<br><br>" & _
            body4 & "<br><br><img src='cid:Sign'></body></html>"

        ' Attach the image and set the Content-ID
        Set imgAttachment = .Attachments.Add(imgPath)
        imgAttachment.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "Sign"

        .Attachments.Add "C:\Users\logit\OneDrive\Desktop\Steak Pot Roast.txt"
        .Display
        '.Send
    End With
End Sub

You'll need to edit to code relating to attachment names, etc.
 
Upvote 0
Logit said:
The following has been tested and works here. It requires the user to have Outlook installed on their computer. They DO NOT need to
have internet access ... the code only uses the Schema imbedded in Outlook.

VBA Code: 
Sub sendfile()
    Dim eapp As Object
    Set eapp = CreateObject("Outlook.Application")
    Dim eitem As Object
    Dim fileNo As Long
    Dim Filename As String
    Dim fname As String
    Dim Path As String
    Dim body As String, body2 As String, body3 As String, body4 As String
    Dim imgPath As String
    Dim imgAttachment As Object

    Set eitem = eapp.CreateItem(0)
    fileNo = Range("B1").Value
    Filename = Range("B2").Value
    body = Range("E5").Value
    body2 = Range("E6").Value
    body3 = Range("E7").Value
    body4 = Range("E8").Value

    Path = "C:\Users\logit\OneDrive\Desktop\booking list.xlsm"
    fname = Filename & " - " & fileNo

    imgPath = "C:\Users\logit\OneDrive\Desktop\Sign.jpg"

    With eitem
        .To = Range("B3").Value
        .CC = Range("B4").Value
        .Subject = Filename & fileNo
        .BodyFormat = 2 ' Set to HTML format
        .HTMLBody = "<html><body>Dear All,<br><br>" & _
            body2 & fileNo & "<br><br>" & _
            body3 & "<br><br>" & _
            body4 & "<br><br><img src='cid:Sign'></body></html>"

        ' Attach the image and set the Content-ID
        Set imgAttachment = .Attachments.Add(imgPath)
        imgAttachment.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "Sign"

        .Attachments.Add "C:\Users\logit\OneDrive\Desktop\Steak Pot Roast.txt"
        .Display
        '.Send
    End With
End Sub

You'll need to edit to code relating to attachment names, etc.
Click to expand...
Thank you so much Logit for the great effort and being pateint to create a code - I have changed the path of the file and image but unfortunately it keep giving me error "operation failed" as you can see in the screenshot - I would like to let you know that I already have a signature in my outlook that appear automatically in all my new emails or replays and it's all text no images, the same like my signature image, is it possible to make it appear also when sending this file as it's considered as new email or we have to attach it as image? thank you in advance
Untitled.png
 
Upvote 0
while i was searching to slove my problem I have found a way to make my outlook signature appear automatically when sending this email. I have change a part of the code and it seem working but with large spaces between the signature lines and it repeated my email and website address not like the normail email signature format.. like this


Best Regards,



Ramadan Moussa

Head Office .



NEWFIZA



Email: permission@newgiza.com <mailto:permission@newgiza.com>

Phone: 7536

Mobile: (+2‎) 01004005904

Address: km22 ‎– Alex Desert Road

Giza – Egypt

www.newgiza.com <NEWGIZA>

and this is the part i changed in the code

VBA Code: 
[CODE=vba][With eitem
.Display
End With

Signature = eitem.body
With eitem

    .to = Range("B3")
    .cc = Range("b4")
    .Subject = Filename & fileNo
    .body = "Dear All " _
    & vbCrLf _
    & vbCrLf _
    & body2 & fileNo _
    & vbCrLf _
    & vbCrLf _
    & body3 _
    & vbCrLf _
    & vbCrLf _
    & body4 & Signature
   
   
    .Attachments.Add "D:\Desktop\Guards\gurads list.xlsm"
        
    .Send

End With
End Sub]

can you fix this please
 
Upvote 0
Try this macro. Note that the email body text must be in HTML format, where <p>....</p> tags are used for paragraphs and <br> for new lines in the same paragraph. I used Option Explicit which means I had to declare your undeclared variables and used ActiveSheet for the unqualified Range references.

VBA Code: 
Option Explicit

Public Sub Send_Email_With_Default_Signature()

    Dim outApp As Object 'Outlook.Application
    Dim outMail As Object
    Dim newHTML As String
    Dim HTML As String, p1 As Long, p2 As Long
  
    Dim fileNo As String, Filename As String, Body As String, body2 As String, body3 As String, body4 As String
    Dim ToEmail As String, CCEmail As String
    With ActiveSheet
        fileNo = .Range("B1").Value
        Filename = .Range("B2").Value
        ToEmail = .Range("B3").Value
        CCEmail = .Range("B4").Value
        Body = .Range("E5").Value
        body2 = .Range("E6").Value
        body3 = .Range("E7").Value
        body4 = .Range("E8").Value
    End With
  
    Dim Path As String, fname As String
    Path = "D:\Desktop\Docs\booking list.xlsm\"
    fname = Filename & " - " & fileNo
  
    newHTML = "<p>Dear All,</p>" & _
              "<p>" & body2 & fileNo & "</p>" & _
              "<p>" & body3 & "</p>" & _
              "<p>" & body4 & "</p>" & _
              "<p>Another paragraph here.<br>New line in same paragraph.</p>"
  
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)

    'Read the default signature HTML in a new email
  
    With outMail
        .GetInspector
        HTML = .HTMLbody
    End With
  
    'Remove first 2 <p> tags in HTMLbody.  In Outlook 2016 and higher both these contain only &nbsp;, resulting in blank paragraphs
  
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & Mid(HTML, p2 + Len("</p>"))
  
    'Find end of opening body tag and insert new HTML after it
  
    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & newHTML & Mid(HTML, p1 + 1)

    'Create and send the HTML email
  
    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Filename & fileNo
        .HTMLbody = HTML
        .Attachments.Add "D:\Desktop\Guards\gurads list.xlsm"
        .Display
        .Send
    End With
  
    Set outMail = Nothing
    Set outApp = Nothing

End Sub
 
Last edited:
Upvote 0
Solution
John_w said:
Try this macro. Note that the email body text must be in HTML format, where <p>....</p> tags are used for paragraphs and <br> for new lines in the same paragraph. I used Option Explicit which means I had to declare your undeclared variables and used ActiveSheet for the unqualified Range references.

VBA Code: 
Option Explicit

Public Sub Send_Email_With_Default_Signature()

    Dim outApp As Object 'Outlook.Application
    Dim outMail As Object
    Dim newHTML As String
    Dim HTML As String, p1 As Long, p2 As Long
 
    Dim fileNo As String, Filename As String, Body As String, body2 As String, body3 As String, body4 As String
    Dim ToEmail As String, CCEmail As String
    With ActiveSheet
        fileNo = .Range("B1").Value
        Filename = .Range("B2").Value
        ToEmail = .Range("B3").Value
        CCEmail = .Range("B4").Value
        Body = .Range("E5").Value
        body2 = .Range("E6").Value
        body3 = .Range("E7").Value
        body4 = .Range("E8").Value
    End With
 
    Dim Path As String, fname As String
    Path = "D:\Desktop\Docs\booking list.xlsm\"
    fname = Filename & " - " & fileNo
 
    newHTML = "<p>Dear All,</p>" & _
              "<p>" & body2 & fileNo & "</p>" & _
              "<p>" & body3 & "</p>" & _
              "<p>" & body4 & "</p>" & _
              "<p>Another paragraph here.<br>New line in same paragraph.</p>"
 
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)

    'Read the default signature HTML in a new email
 
    With outMail
        .GetInspector
        HTML = .HTMLbody
    End With
 
    'Remove first 2 <p> tags in HTMLbody.  In Outlook 2016 and higher both these contain only &nbsp;, resulting in blank paragraphs
 
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & Mid(HTML, p2 + Len("</p>"))
 
    'Find end of opening body tag and insert new HTML after it
 
    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & newHTML & Mid(HTML, p1 + 1)

    'Create and send the HTML email
 
    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Filename & fileNo
        .HTMLbody = HTML
        .Attachments.Add "D:\Desktop\Guards\gurads list.xlsm"
        .Display
        .Send
    End With
 
    Set outMail = Nothing
    Set outApp = Nothing

End Sub
Click to expand...
Perfect Mr. John_w it's exactly what I need - just one issue need to fix - I want to remove the line of " "<p>Another paragraph here.<br>New line in same paragraph.</p>" because it appears in the email body and I don't need any more text to add - I have tried to mark it as comment but got error
 
Upvote 0
Ramadan said:
I want to remove the line of " "<p>Another paragraph here.<br>New line in same paragraph.</p>" because it appears in the email body and I don't need any more text to add - I have tried to mark it as comment but got error
Click to expand...

That was just to demonstrate the <br> tag. To fix the error, delete the & _ at the end of the previous line.
 
Upvote 0
John_w said:
That was just to demonstrate the <br> tag. To fix the error, delete the & _ at the end of the previous line.
Click to expand...
Ohhh I only removed _ not &_ it's ok now - please one last issue , I tried to refer to cells in other sheet like herein below but it doesnt work. how should it be? if i want to put the source data in sheet2

With ActiveSheet
fileNo = Sheet2.Range("B1").Value
Filename = Sheet2.Range("B2").Value
ToEmail = Sheet2.Range("B3").Value
CCEmail = Sheet2.Range("B4").Value
Body = Sheet2.Range("B5").Value
body2 = Sheet2.Range("B6").Value
body3 = Sheet2.Range("B7").Value
body4 = Sheet2.Range("B8").Value
End With

thanks in advance
 
Upvote 0
VBA Code: 
    With Worksheets("Sheet2")
        fileNo = .Range("B1").Value
        Filename = .Range("B2").Value
        ToEmail = .Range("B3").Value
        CCEmail = .Range("B4").Value
        Body = .Range("B5").Value
        body2 = .Range("B6").Value
        body3 = .Range("B7").Value
        body4 = .Range("B8").Value
    End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
.HTMLBody not working
Replies
1
Views
222
DanteAmor
DanteAmor
L
  • Question Question
Making certain words bold and italicized in the body of the text of an email vba
Replies
3
Views
614
Trevor G
Trevor G
L
  • Locked
  • Question Question
How to stop VBA from creating pdf from drop-down list if the value is empty?
Replies
1
Views
389
Fluff
Fluff
L
  • Question Question
Sending Email with Table in Body
Replies
3
Views
971
Domenic
D
L
  • Question Question
How to fix VBA code to stop saving and emailing PDF of blank cell from data validation list?
Replies
2
Views
326
lharr28
L

Forum statistics

Threads
1,226,121
Messages
6,189,088
Members
453,524
Latest member
AshJames

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