VBA code help - email with attachment link

lost_in_the_sauce

Board Regular
Joined
Jan 18, 2021
Messages
128
Office Version
  1. 365
Platform
  1. Windows
Large invoice tracking spreadsheet - trying to run a code that will send an email to each recipient in column C if there is a "Y" in column E, and attaching a pdf from a file path in G. I can update the subject line and body each month in the code before sending.

VBA Code:
Sub Sendmail_Attach

If Range(“E:E”).Value = Y Then

Dim EmailApp As Outlook.Application

Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem

Set EmailItem = EmailApp.CreateItem(olMailItem)

.To = emailTo Cells(C:C).Value

..CC = ""

.BCC = ""

.Subject = "Invoice update request"

.Attachments.Add Range("G:G").Value

.Body = emailBody

'.Send

.Display

End With



Set OutMail = Nothing

Set OutApp = Nothing

End If



Next

End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
I can't promise that I can do this but I'll try. If not me then possibly other people who are smarter about Excel.

If you want assistance you are more likely to get help if you help the helper so they do not need to guess about or recreate your data.

If the data is not confidential post a link to your workbook. If necessary you can enter fake-but-realistic data before providing the link. Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the message area. Make sure that other people can access the file!

Or, consider sharing relevant data using Mr Excel's excellent XL2BB addin that enables you to post a portion of a worksheet. See XL2BB - Excel Range to BBCode for details.
 
Upvote 0
I can't promise that I can do this but I'll try. If not me then possibly other people who are smarter about Excel. If you want assistance you are more likely to get help if you help the helper so they do not need to guess about or recreate your data. If the data is not confidential post a link to your workbook. If necessary you can enter fake-but-realistic data before providing the link. Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the message area. Make sure that other people can access the file! Or, consider sharing relevant data using Mr Excel's excellent XL2BB addin that enables you to post a portion of a worksheet. See XL2BB - Excel Range to BBCode for details.

Book1
ABCDEFGHIJKLMNOP
1BrandInvoice DateBill To NameInvoice NumberCompanyE-mailRegistration Fees QTYHotel Rooms QTYRegistration Fees Amt Hotel Rooms AMT Invoice Total E-mailed? E-mailed Date Paid? Payment Date InvoicePath
2Ace7/25/2023ChadA00001A LLCChad@fake.com211000.00900.001900.00Y7/26/2023file:///c:\Users\employee\box\files\A00001.pdf
3Ace7/25/2023JamesA00002B LLCJames@fake.com11500.00900.001400.00Y7/26/2023Y7/26/2023file:///c:\Users\employee\box\files\A00002.pdf
4Ace7/25/2023JamesA00003C LLCJames@fake.com11500.00900.001400.00Y7/26/2023file:///c:\Users\employee\box\files\A00003.pdf
5Ace7/25/2023BrianA00004A LLCBrian@fake.com1None500.000.00500.00Y7/26/2023Y7/26/2023file:///c:\Users\employee\box\files\A00004.pdf
6Ace7/25/2023BrianA00005B LLCBrian@fake.com1None500.000.00500.00Nfile:///c:\Users\employee\box\files\A00005.pdf
7Ace7/25/2023BrianA00006C LLCBrian@fake.com11500.00900.001400.00Yfile:///c:\Users\employee\box\files\A00006.pdf
8Ace7/25/2023ChadA00007A LLCChad@fake.com11500.00900.001400.00Y7/26/2023file:///c:\Users\employee\box\files\A00007.pdf
9Ace7/27/2023ChadA00008B LLCChad@fake.com211000.00900.001900.00Y7/26/2023file:///c:\Users\employee\box\files\A00008.pdf
10Ace7/25/2023ChadA00009C LLCChad@fake.com211000.00900.001900.00Y7/26/2023Y7/26/2023file:///c:\Users\employee\box\files\A00009.pdf
11Dart7/10/2023HankD00001A LLCHank@fake.com211000.00900.001900.00Y7/26/2023file:///c:\Users\employee\box\files\D00001.pdf
12Dart7/10/2023HankD00002B LLCHank@fake.com211000.00900.001900.00Y7/26/2023file:///c:\Users\employee\box\files\D00002.pdf
13Dart7/10/2023HankD00003C LLCHank@fake.com532500.002700.005200.00Nfile:///c:\Users\employee\box\files\D00003.pdf
14Dart7/10/2023HankD00004A LLCHank@fake.com11500.00900.001400.00Y7/26/2023Y7/26/2023file:///c:\Users\employee\box\files\D00004.pdf
15Dart7/10/2023ChadD00005B LLCChad@fake.com211000.00900.001900.00Y7/27/2023file:///c:\Users\employee\box\files\D00005.pdf
16Dart7/10/2023JamesD00006C LLCJames@fake.com11500.00900.001400.00Y7/26/2023Y7/26/2023file:///c:\Users\employee\box\files\D00006.pdf
17Dart7/10/2023JamesD00007A LLCJames@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\D00007.pdf
18Dart7/10/2023BrianD00008B LLCBrian@fake.com211000.00900.001900.00Y7/10/2023file:///c:\Users\employee\box\files\D00008.pdf
19Dart7/10/2023BrianD00009C LLCBrian@fake.com11500.00900.001400.00Nfile:///c:\Users\employee\box\files\D00009.pdf
20Dart7/10/2023BrianD000010A LLCBrian@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\D000010.pdf
21Fenway7/10/2023ChadF00001B LLCChad@fake.com211000.00900.001900.00Y7/10/2023Y7/26/2023file:///c:\Users\employee\box\files\F00001.pdf
22Fenway7/10/2023ChadF00002C LLCChad@fake.com11500.00900.001400.00Y7/10/2023Y7/26/2023file:///c:\Users\employee\box\files\F00002.pdf
23Fenway7/10/2023ChadF00003A LLCChad@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\F00003.pdf
24Fenway7/10/2023HankF00004B LLCHank@fake.com211000.00900.001900.00Y7/10/2023file:///c:\Users\employee\box\files\F00004.pdf
25Fenway7/10/2023HankF00005C LLCHank@fake.com11500.00900.001400.00Y7/10/2023file:///c:\Users\employee\box\files\F00005.pdf
26Fenway7/25/2023HankF00006A LLCHank@fake.com211000.00900.001900.00Y7/10/2023file:///c:\Users\employee\box\files\F00006.pdf
27Fenway7/25/2023HankF00007B LLCHank@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\F00007.pdf
28Fenway7/25/2023ChadF00008C LLCChad@fake.com11500.00900.001400.00Y7/10/2023Y7/26/2023file:///c:\Users\employee\box\files\F00008.pdf
29Fenway7/25/2023JamesF00009A LLCJames@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\F00009.pdf
30Fenway7/25/2023JamesF000010B LLCJames@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\F000010.pdf
31Fenway7/27/2023BrianF000011C LLCBrian@fake.com11500.00900.001400.00Nfile:///c:\Users\employee\box\files\F000011.pdf
32Fenway7/25/2023BrianF000012A LLCBrian@fake.com211000.00900.001900.00Nfile:///c:\Users\employee\box\files\F000012.pdf
33Fenway7/25/2023BrianF000013B LLCBrian@fake.com211000.00900.001900.00Y7/10/2023file:///c:\Users\employee\box\files\F000013.pdf
Sheet1
Cell Formulas
RangeFormula
K2:K33K2=SUM(I2:J2)
 
Upvote 0
Goal is to send an individual email to any name (column C) at address (column F) with attachment linked (column P) if column L is a "N"
 
Upvote 0
I hope that this does what is wanted. If you need more help then ask.

VBA Code:
Option Explicit

Sub SendEmailsWithAttachment()

'   Worksheet containing the data.
    Dim wsData As Worksheet
   
    Dim sSenderCompanyName As String
   
    Dim sInvoiceDate As String
   
    Dim sRecipientName As String
       
    Dim sEmailAddress As String
   
    Dim sEmailSubject As String
   
    Dim sInvoiceTotal As String
   
    Dim sIsEmailed As String
   
    Dim sIsPaid As String
   
    Dim sFileNameAndPath As String
   
    Dim sEmailBody As String
   
    Dim iDataRow As Long
   
    Dim iDataRowsCount As Long
   
    sSenderCompanyName = "Hotel California"
   
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
   
'   Get count of data rows to proess, minus one to account for header row.
    iDataRowsCount = wsData.Range("A1").CurrentRegion.Rows.Count - 1
   
'   Iterate through the entries in the data.
    With wsData.Range("A1").Offset(1)
   
        For iDataRow = 1 To iDataRowsCount
           
            sIsEmailed = UCase(Left(.Cells(iDataRow, 12).Value, 1))
           
            sIsPaid = UCase(Left(.Cells(iDataRow, 14).Value, 1))
           
            If sIsEmailed = "N" And sIsPaid <> "Y" _
             Then
            
                sRecipientName = .Cells(iDataRow, 3)
               
                sFileNameAndPath = .Cells(iDataRow, 16)

'               Tell user if the attachment was not found.
                If Dir(sFileNameAndPath) = "" _
                 Then
                   
                    MsgBox "The attachment for recipient " & sRecipientName & " was not found." _
                           & Chr(10) & Chr(10) _
                           & sFileNameAndPath, vbExclamation
                       
                Else

                    sInvoiceDate = .Cells(iDataRow, 2)
   
                    sInvoiceTotal = Format(.Cells(iDataRow, 11), "$#,##0.00")
                   
                    sEmailSubject = sSenderCompanyName & " invoice"
   
                    sEmailAddress = .Cells(iDataRow, 6)
                   
'                   Create the email body.
                    sEmailBody = "Hello " & sRecipientName _
                               & ". Attached please find your invoice dated " _
                               & sInvoiceDate & " for " _
                                   & sInvoiceTotal & "."
   
'                   Call function that does the send. Two "empty" commas are for CC and BCC fields which are N/A.
                    Call SendEmail(sEmailAddress, sEmailSubject, sEmailBody, , , sFileNameAndPath, True)

'                   Set Emailed ? and Emailed Date data for the person.
                    .Cells(iDataRow, 12).Value = "Y"
   
                    .Cells(iDataRow, 13).Value = Format(Now(), "m/d/yyyy")
               
                End If

            End If
       
        Next iDataRow
   
    End With
   
End Sub

VBA Code:
' ----------------------------------------------------------------
' Procedure Name: SendEmail
' Purpose: Send email to the specified address with specified attachment.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psEmailAddress (String): Email address to send email to.
' Parameter psEmailSubject (String): Email subject line content.
' Parameter sEmailBody (String): Email body content.
' Parameter psPathAndFile (String): Path and file name for the attachment. Empty if no attachment.
' Parameter pbDoSend (Boolean): 1. Send email (True), 2. "display" email first (False).
' Author:  Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function SendEmail( _
    psEmailAddress As String, _
    psEmailSubject As String, _
    psEmailBody As String, _
    Optional psCCRecipients As String = "", _
    Optional psBCCRecipients As String = "", _
    Optional psPathAndFile As String = "", _
    Optional pbDoSend As Boolean = True) As String

'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object

'   Set up Outlook objects for sending email.
    Set oOutlookApp = CreateObject("Outlook.Application")
    Set oMailItem = oOutlookApp.CreateItem(0)
   
    psEmailAddress = Replace(psEmailAddress, ",", ";")
    psCCRecipients = Replace(psCCRecipients, ",", ";")
    psBCCRecipients = Replace(psBCCRecipients, ",", ";")

'   Required: 1. recipient (email address(es)), 2. subject line, 3. body.
    With oMailItem
        .To = psEmailAddress

        .Subject = psEmailSubject

        .Body = psEmailBody

    End With

'   If CC list is not empty then add it.
    If psCCRecipients <> "" _
     Then
        oMailItem.CC = psCCRecipients
    End If

'   If BCC list is not empty then add it.
    If psBCCRecipients <> "" _
     Then
        oMailItem.BCC = psBCCRecipients
    End If

'   If path to a file to attach is exists then add it.
    If psPathAndFile <> "" _
     Then
        If Dir(psPathAndFile) <> "" _
         Then oMailItem.Attachments.Add psPathAndFile
    End If

'   Either 1. send the email or 2. "display" it so user can see it
'   before it is sent. Default is to send.
    If pbDoSend _
     Then
        oMailItem.Send
    Else
        oMailItem.Display
    End If
'
    SendEmail = "Sent"

End Function
 
Last edited:
Upvote 0
I hope that this does what is wanted. If you need more help then ask.

VBA Code:
Option Explicit

Sub SendEmailsWithAttachment()

'   Worksheet containing the data.
    Dim wsData As Worksheet
  
    Dim sSenderCompanyName As String
  
    Dim sInvoiceDate As String
  
    Dim sRecipientName As String
      
    Dim sEmailAddress As String
  
    Dim sEmailSubject As String
  
    Dim sInvoiceTotal As String
  
    Dim sIsEmailed As String
  
    Dim sIsPaid As String
  
    Dim sFileNameAndPath As String
  
    Dim sEmailBody As String
  
    Dim iDataRow As Long
  
    Dim iDataRowsCount As Long
  
    sSenderCompanyName = "Hotel California"
  
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
  
'   Get count of data rows to proess, minus one to account for header row.
    iDataRowsCount = wsData.Range("A1").CurrentRegion.Rows.Count - 1
  
'   Iterate through the entries in the data.
    With wsData.Range("A1").Offset(1)
  
        For iDataRow = 1 To iDataRowsCount
          
            sIsEmailed = UCase(Left(.Cells(iDataRow, 12).Value, 1))
          
            sIsPaid = UCase(Left(.Cells(iDataRow, 14).Value, 1))
          
            If sIsEmailed = "N" And sIsPaid <> "Y" _
             Then
           
                sRecipientName = .Cells(iDataRow, 3)
              
                sFileNameAndPath = .Cells(iDataRow, 16)

'               Tell user if the attachment was not found.
                If Dir(sFileNameAndPath) = "" _
                 Then
                  
                    MsgBox "The attachment for recipient " & sRecipientName & " was not found." _
                           & Chr(10) & Chr(10) _
                           & sFileNameAndPath, vbExclamation
                      
                Else

                    sInvoiceDate = .Cells(iDataRow, 2)
  
                    sInvoiceTotal = Format(.Cells(iDataRow, 11), "$#,##0.00")
                  
                    sEmailSubject = sSenderCompanyName & " invoice"
  
                    sEmailAddress = .Cells(iDataRow, 6)
                  
'                   Create the email body.
                    sEmailBody = "Hello " & sRecipientName _
                               & ". Attached please find your invoice dated " _
                               & sInvoiceDate & " for " _
                                   & sInvoiceTotal & "."
  
'                   Call function that does the send. Two "empty" commas are for CC and BCC fields which are N/A.
                    Call SendEmail(sEmailAddress, sEmailSubject, sEmailBody, , , sFileNameAndPath, True)

'                   Set Emailed ? and Emailed Date data for the person.
                    .Cells(iDataRow, 12).Value = "Y"
  
                    .Cells(iDataRow, 13).Value = Format(Now(), "m/d/yyyy")
              
                End If

            End If
      
        Next iDataRow
  
    End With
  
End Sub

VBA Code:
' ----------------------------------------------------------------
' Procedure Name: SendEmail
' Purpose: Send email to the specified address with specified attachment.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psEmailAddress (String): Email address to send email to.
' Parameter psEmailSubject (String): Email subject line content.
' Parameter sEmailBody (String): Email body content.
' Parameter psPathAndFile (String): Path and file name for the attachment. Empty if no attachment.
' Parameter pbDoSend (Boolean): 1. Send email (True), 2. "display" email first (False).
' Author:  Jim
' Date: 6/15/2023
' ----------------------------------------------------------------

Function SendEmail( _
    psEmailAddress As String, _
    psEmailSubject As String, _
    psEmailBody As String, _
    Optional psCCRecipients As String = "", _
    Optional psBCCRecipients As String = "", _
    Optional psPathAndFile As String = "", _
    Optional pbDoSend As Boolean = True) As String

'   Objects used for sending email via outlook.
    Dim oOutlookApp As Object
    Dim oMailItem As Object

'   Set up Outlook objects for sending email.
    Set oOutlookApp = CreateObject("Outlook.Application")
    Set oMailItem = oOutlookApp.CreateItem(0)
  
    psEmailAddress = Replace(psEmailAddress, ",", ";")
    psCCRecipients = Replace(psCCRecipients, ",", ";")
    psBCCRecipients = Replace(psBCCRecipients, ",", ";")

'   Required: 1. recipient (email address(es)), 2. subject line, 3. body.
    With oMailItem
        .To = psEmailAddress

        .Subject = psEmailSubject

        .Body = psEmailBody

    End With

'   If CC list is not empty then add it.
    If psCCRecipients <> "" _
     Then
        oMailItem.CC = psCCRecipients
    End If

'   If BCC list is not empty then add it.
    If psBCCRecipients <> "" _
     Then
        oMailItem.BCC = psBCCRecipients
    End If

'   If path to a file to attach is exists then add it.
    If psPathAndFile <> "" _
     Then
        If Dir(psPathAndFile) <> "" _
         Then oMailItem.Attachments.Add psPathAndFile
    End If

'   Either 1. send the email or 2. "display" it so user can see it
'   before it is sent. Default is to send.
    If pbDoSend _
     Then
        oMailItem.Send
    Else
        oMailItem.Display
    End If
'
    SendEmail = "Sent"

End Function
Do I enter both as separate macros in the VBA window then run each one?
 
Upvote 0
Because you posted code I thought that you'd know what to do with the new code. The Sub does the setup and the Function plays a "support" role by doing the actual sending of the messages. Put them into separate code modules. Run the Sub. Good luck. Let me know if it works for you.
 
Upvote 0
Note that I set up the code so it will send email if there is a No in the Email sent field unless the customer has already paid. I hope that is correct?
 
Upvote 0
Note that I set up the code so it will send email if there is a No in the Email sent field unless the customer has already paid. I hope that is correct?
correct, the email should send if the is a no in column N.

Thank you!
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,112
Members
452,302
Latest member
TaMere

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