locked
send e-mail with attachment through excel RRS feed

  • Question

  • Does anyone know how I need to amend my code to make the attachement portion work? All the other items work.

    Here is my 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, 7)
           
        Subj = Cells(ActiveCell.Row, 2)

        Msg = ""
        Msg = Msg & "Hello" & "," & vbCrLf & vbCrLf & " Please find attached file. "     
        '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

    Thursday, August 2, 2012 11:08 AM

Answers

  • Hello:

    Just to add to the comments of some of our other skilled contributors (Asadulla Javed, Ryan Shuell) I have had the best luck using the Outlook API as noted by the other posts.  Here's a sample of a program that sends emails with an attachment to a list of email addresses in column A.

    You can find a working example of this program at:

    Send Email With Attachment

    When you click the link, right click the file "SendEmailWithAttachment2007" and select "Download".  Here's the code:

    Option Explicit
    
    Public Sub SendEmailsWithAttachment()
    ' ****************************************************************
    ' Define Variables
    ' ****************************************************************
    Dim wkbRecipientList As Workbook
    Dim wksRecipientList As Worksheet
    Dim lngNumberOfRowsInRecipients As Long
    Dim strPathToAttachment As String
    Dim i As Long
    
    ' ****************************************************************
    ' Set Workbook and Worksheet Variables
    ' ****************************************************************
    Set wkbRecipientList = ActiveWorkbook
    Set wksRecipientList = ActiveWorkbook.ActiveSheet
    
    ' ****************************************************************
    ' Set the Path To The Attachment (Replace This With Your Path)
    ' ****************************************************************
    strPathToAttachment = "C:\TestArea\TestData.txt"
    
    ' ****************************************************************
    ' Determine How Many Rows Are In the Worksheet in Column A
    ' ****************************************************************
    lngNumberOfRowsInRecipients = wksRecipientList.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' ****************************************************************
    ' Row 1 Is Headers, Row 2 Starts The Data
    ' ****************************************************************
    For i = 2 To lngNumberOfRowsInRecipients
    ' ****************************************************************
    ' Send An Email Message With Attachment
    ' And Check To See That It Is Successful
    ' If Successful, Bold the Font Of The Email Address
    ' ****************************************************************
    If SendAnOutlookEmail(wksRecipientList, i, strPathToAttachment) Then
       wksRecipientList.Cells(i, 1).Font.Bold = True
    End If
    
    Next i
    
    End Sub
    
    Private Function SendAnOutlookEmail(WorkSheetSource As Worksheet, RowNumber As Long, AttachmentFile As String) As Boolean
    Dim strMailToEmailAddress As String
    Dim strSubject As String
    Dim strBody As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    SendAnOutlookEmail = False
    
    strMailToEmailAddress = WorkSheetSource.Cells(RowNumber, 1)
    strSubject = "Please See Attachment"
    strBody = "Your File Has Been Attached To This Email"
    
    ' ****************************************************************
    ' Create The Outlook Mail Object
    ' ****************************************************************
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    ' ****************************************************************
    ' Send The Email
    ' ****************************************************************
    On Error GoTo ErrorOccurred
    With OutMail
        .To = strMailToEmailAddress
        .Subject = strSubject
        .Body = strBody
        .Attachments.Add AttachmentFile
        .Send
    End With
    
    ' ****************************************************************
    ' Mail Was Successful
    ' ****************************************************************
    SendAnOutlookEmail = True
    
    Continue:
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Exit Function
    
    ' ****************************************************************
    ' Mail Was Not Successful
    ' ****************************************************************
    ErrorOccurred:
    
    Resume Continue
    End Function
    

    It should take very little effort to revamp this to your requirements.  One more point to note.  If you have a compile error, make sure that in the VBA Editor, you select Tools, References and include the Microsoft Outlook Library.  This will work for Excel 2007 or 2010.

    Regards,


    Rich Locus, Logicwurks, LLC

    http://www.logicwurks.com

    • Proposed as answer by Leo_Gao Monday, August 6, 2012 2:21 AM
    • Marked as answer by Leo_Gao Friday, August 10, 2012 1:44 AM
    Friday, August 3, 2012 11:23 PM
  • If the objective is to send different files to different recipients (in an array), check this out:

    http://www.rondebruin.nl/mail/folder3/message.htm

    I used this code for close to a year when I used to work at Yahoo!  It never failed, even one time.


    Ryan Shuell

    • Marked as answer by Leo_Gao Friday, August 10, 2012 1:45 AM
    Saturday, August 4, 2012 12:08 PM

All replies

  • To get ultimate programmabilty think of MS OutLook.As far as I know By MailTo you can't use Attachment.


    Asadulla Javed

    Thursday, August 2, 2012 11:55 AM
    Answerer
  • There are MANY samples here:

    http://www.rondebruin.nl/sendmail.htm


    Ryan Shuell

    Friday, August 3, 2012 4:19 AM
  • Hello:

    Just to add to the comments of some of our other skilled contributors (Asadulla Javed, Ryan Shuell) I have had the best luck using the Outlook API as noted by the other posts.  Here's a sample of a program that sends emails with an attachment to a list of email addresses in column A.

    You can find a working example of this program at:

    Send Email With Attachment

    When you click the link, right click the file "SendEmailWithAttachment2007" and select "Download".  Here's the code:

    Option Explicit
    
    Public Sub SendEmailsWithAttachment()
    ' ****************************************************************
    ' Define Variables
    ' ****************************************************************
    Dim wkbRecipientList As Workbook
    Dim wksRecipientList As Worksheet
    Dim lngNumberOfRowsInRecipients As Long
    Dim strPathToAttachment As String
    Dim i As Long
    
    ' ****************************************************************
    ' Set Workbook and Worksheet Variables
    ' ****************************************************************
    Set wkbRecipientList = ActiveWorkbook
    Set wksRecipientList = ActiveWorkbook.ActiveSheet
    
    ' ****************************************************************
    ' Set the Path To The Attachment (Replace This With Your Path)
    ' ****************************************************************
    strPathToAttachment = "C:\TestArea\TestData.txt"
    
    ' ****************************************************************
    ' Determine How Many Rows Are In the Worksheet in Column A
    ' ****************************************************************
    lngNumberOfRowsInRecipients = wksRecipientList.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' ****************************************************************
    ' Row 1 Is Headers, Row 2 Starts The Data
    ' ****************************************************************
    For i = 2 To lngNumberOfRowsInRecipients
    ' ****************************************************************
    ' Send An Email Message With Attachment
    ' And Check To See That It Is Successful
    ' If Successful, Bold the Font Of The Email Address
    ' ****************************************************************
    If SendAnOutlookEmail(wksRecipientList, i, strPathToAttachment) Then
       wksRecipientList.Cells(i, 1).Font.Bold = True
    End If
    
    Next i
    
    End Sub
    
    Private Function SendAnOutlookEmail(WorkSheetSource As Worksheet, RowNumber As Long, AttachmentFile As String) As Boolean
    Dim strMailToEmailAddress As String
    Dim strSubject As String
    Dim strBody As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    SendAnOutlookEmail = False
    
    strMailToEmailAddress = WorkSheetSource.Cells(RowNumber, 1)
    strSubject = "Please See Attachment"
    strBody = "Your File Has Been Attached To This Email"
    
    ' ****************************************************************
    ' Create The Outlook Mail Object
    ' ****************************************************************
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    ' ****************************************************************
    ' Send The Email
    ' ****************************************************************
    On Error GoTo ErrorOccurred
    With OutMail
        .To = strMailToEmailAddress
        .Subject = strSubject
        .Body = strBody
        .Attachments.Add AttachmentFile
        .Send
    End With
    
    ' ****************************************************************
    ' Mail Was Successful
    ' ****************************************************************
    SendAnOutlookEmail = True
    
    Continue:
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Exit Function
    
    ' ****************************************************************
    ' Mail Was Not Successful
    ' ****************************************************************
    ErrorOccurred:
    
    Resume Continue
    End Function
    

    It should take very little effort to revamp this to your requirements.  One more point to note.  If you have a compile error, make sure that in the VBA Editor, you select Tools, References and include the Microsoft Outlook Library.  This will work for Excel 2007 or 2010.

    Regards,


    Rich Locus, Logicwurks, LLC

    http://www.logicwurks.com

    • Proposed as answer by Leo_Gao Monday, August 6, 2012 2:21 AM
    • Marked as answer by Leo_Gao Friday, August 10, 2012 1:44 AM
    Friday, August 3, 2012 11:23 PM
  • If the objective is to send different files to different recipients (in an array), check this out:

    http://www.rondebruin.nl/mail/folder3/message.htm

    I used this code for close to a year when I used to work at Yahoo!  It never failed, even one time.


    Ryan Shuell

    • Marked as answer by Leo_Gao Friday, August 10, 2012 1:45 AM
    Saturday, August 4, 2012 12:08 PM
  • Is there a way to modify this code to send email on behalf of?
    Monday, March 13, 2017 10:49 PM
  • Is there a way to adjusted to send email on behalf of someone else, such as mailbox?
    Wednesday, March 15, 2017 3:58 PM