View Full Version : Required Email generated with signature and attachments

08-09-2017, 08:58 PM
Hi All,

I've been tweaking with this code and it works out well. I just need some minor addition to this by having:
1. My Outlook email signature added,
2. File attachments added (folder path as indicated in the column)

Here is the code that I have currently:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Cells(ActiveCell.Row, 3)

Subj = Cells(ActiveCell.Row, 4)

Msg = ""
Msg = Msg & "This is your follow up delivery notification" & vbCrLf & vbCrLf & "Dear " & Cells(ActiveCell.Row, 2) & vbCrLf & vbCrLf & "Please be informed that this shipment have been received by: " & vbCrLf & vbCrLf & "Name : " & Cells(ActiveCell.Row, 9) & vbCrLf & "Location : " & Cells(ActiveCell.Row, 8) & vbCrLf & vbCrLf & "Invoice No: " & Cells(ActiveCell.Row, 6) & vbCrLf & vbCrLf & "Delivery Order No :" & Cells(ActiveCell.Row, 7) & vbCrLf
'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:02"))
'Application.SendKeys "%s"
End Sub

I've also attached a file for easy reference.

Thanks Guys.

08-10-2017, 02:00 AM
In order to write to the body of the message and include the signature, you need to program Outlook directly to create the message. I have added in the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm to open Outlook properly, and modified the code associated with the button to create the message, which should display the signature associated with the sending account.

The attachment path does not appear to represent a valid filename, in that there is no extension provided. You can add the extension to the code where the attachment is added. e.g.

.attachments.Add Cells(ActiveCell.Row, 10) & ".docx" if the file is a document. If the file does not exist or the path is wrong, the code will not appreciate it. It would probably be wise to add code to validate whether the file exists at the named location before attempting to add it.

08-10-2017, 07:47 PM
Hi Graham,
Thank you for your assistance. The signature is working fine now.

As for the attachments, I might have a combination of file(s) with filename extension of say e.g. pdf, jpeg, xls or doc. So I can't specific the exact file extensions to be used in the vba code. I would therefore need a code that would loop thru the folder(folder path as shown in Column J) and attached all files in that folder to my email.


c:\Order\2017\2017 - Quarter1\MX 30001\ (This folder might consist of 3 files; xls, jpeg, pdf)
c:\Order\2017\2017 - Quarter1\MX 30002\ (This folder might consist of 1 files; jpeg)

Hope I don't sound confusing :)

08-10-2017, 10:13 PM
OK. declare two more string variables strFile and strFolder, then change the line

.attachments.Add Cells(ActiveCell.Row, 10)

strFolder = Cells(ActiveCell.Row, 10) & "\"
strFile = Dir$(strPath & "*.*")
While strFile <> ""
.attachments.Add strFolder & strFile
strFile = Dir$()
This should add all the files in the named folder to the message as attachments.

08-10-2017, 11:33 PM
Hi Graham,
I got an error message after declaring the two string variables strFile and strFolder. The error message I got is on "strPath" with message [Variable not defined].

So I try to declare the "strPath" as string as well and got a new error message stating, [Run-time error "-2147024894 (80070002)': Cannot find this file. Verify the path and file name are correct.]

Any idea where I could have gone wrong?

08-23-2017, 06:56 PM
Hi Graham,
Just to follow up :) thanks.