Consulting

Results 1 to 6 of 6

Thread: Required Email generated with signature and attachments

  1. #1
    VBAX Regular
    Joined
    Aug 2011
    Posts
    60
    Location

    Required Email generated with signature and attachments

    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:

    HTML Code:
    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.
    Email with signature and attachments.xlsmEmail with signature and attachments.xlsm

  2. #2
    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.
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Aug 2011
    Posts
    60
    Location
    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.

    e.g.

    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

  4. #4
    OK. declare two more string variables strFile and strFolder, then change the line

           .attachments.Add Cells(ActiveCell.Row, 10)
    for
            strFolder = Cells(ActiveCell.Row, 10) & "\"
            strFile = Dir$(strPath & "*.*")
            While strFile <> ""
                .attachments.Add strFolder & strFile
                strFile = Dir$()
            Wend
    This should add all the files in the named folder to the message as attachments.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Aug 2011
    Posts
    60
    Location
    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?

  6. #6
    VBAX Regular
    Joined
    Aug 2011
    Posts
    60
    Location
    Hi Graham,
    Just to follow up thanks.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •