aloy78
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.
2004320043
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.
2004320043