Sending Emails with attachments if criteria met

**Hudson** · 02-16-2017, 08:36 AM

Hi all,

I know I am asking for more , but still I would like some assistance on the below

Is there a way we can send E-mail with attachments(PDF) from my local folder . and I wanted this PDF to be attached to my mail only when my excel "column a " number needs to be matched with attachment name in the folder that is there in the column “ D ” . then it should get picked and send to (*************@.com) and so on which is in the column “ C “ with the subject that is there in the column “ E “.

attached is the file I wanted to send E-mail from my sheet . I also mentioned how my attachments get saved I mean the name of the attachment PDF.

**Hudson** · 02-16-2017, 08:38 AM

I tried seeking help from below link but unfortunately no inputs received. Hence I closed that thread.

http://www.excelforum.com/showthread.php?t=1173442.

**gmayor** · 02-16-2017, 10:00 PM

If you add the derived filename of the PDF to the path column of your worksheet, you could use http://www.gmayor.com/ManyToOne.htm in one to one mode, using the customer number as a keyfield to merge to e-mail with the attachment.

**Hudson** · 02-16-2017, 11:59 PM

Hi Gmayor,

Thank you very much for addressing request . i have one quick question after going through the site . i mean mostly my attachments will more than one with same file name . will all of them get attached ?.

**gmayor** · 02-17-2017, 01:57 AM

You can either send the same attachment(s) to each record or attachments selected from fields in the data source (or both).

**Hudson** · 02-17-2017, 02:46 AM

thanks again .I am little confused , how do I associate my requirement with the Add_in that is in the site , because what I observed is and correct me if I am wrong , Add-in needs to be run from MS-word and not from Excel ?...

If you add the derived filename of the PDF to the path column of your worksheet, you could use http://www.gmayor.com/ManyToOne.htm  in one to one mode, using the customer number as a keyfield to merge to e-mail with the attachment.

we can only give path folder , is that possible to give with file name to in my path ?.

sorry for to many questions ...

**gmayor** · 02-17-2017, 05:18 AM

The add-in runs from Word and uses Excel data. Word provides the message body. Unless you are attaching the same document to all messages created, the full path of the attachment must be included for each record in the data source. If you only have the path and can derive the name from text and other fields, add a column to your data file to provide that full path.

However I see I assisted you with a related issue in an earlier thread. It would not be too difficult to modify the code used there to loop through the records in your example, though where the invoice number comes from is anyone's guess.

Sub Mail_Attachments()

Dim OutApp As Object
Dim OutMail As Object
Dim sAttach As String
Dim iLastRow As Integer
Dim shtAddr As Worksheet
Dim xlSheet As Worksheet
Dim iRow As Long
Dim LastRow As Long
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set xlSheet = ActiveWorkbook.Sheets("Email Body")
    xlSheet.Activate
    LastRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    LastRow = 3 'THIS LINE IS FOR TESTING ONLY!!!
    For iRow = 2 To LastRow
        sAttach = xlSheet.Range("D" & iRow) & "Sealing Invoice 12534 - " & xlSheet.Range("A" & iRow) & ".pdf"
        If fso.FileExists(sAttach) Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = xlSheet.Range("C" & iRow)
                .Subject = xlSheet.Range("E" & iRow)
                .Attachments.Add sAttach
                .HTMLBody = "<HTML><BODY>"Please find invoice " & sAttach & " attached" _
                            & "<BR>" & "</HTML></BODY>"
                '        .Send   'or use .Display
                .Display
            End With
        Else
            MsgBox sAttach & vbCr & "Does not exist!"
        End If
    Next iRow
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**Hudson** · 02-24-2017, 05:46 AM

Hello Mayor.

This is fantastic I have tested above code that's brilliant , it has few limitations though. I will be having huge PDF's files like 100 may be and it will save like this ("Sealing Invoice ******- Customer 740000" and Sealing Invoice ***XX- customer 69000" ) so on. can we tweak above code like , any file in the folder that matches with customer number "740000" ignoring entire file name and picking up if file name as customer number "******" ..because my invoices are many but customer IDs are few . for example

I have few files in my folder with below names.

"Sealing Invoice ***XX1- Customer 740000"
"Sealing Invoice ***XX2- Customer 740000"
"Sealing Invoice ***XX3- Customer 740000"
"Sealing Invoice ***XX4- Customer 740000"

so from my excel when I say send it should pick any thing has customer number "740000" in PDF should pick and send to " ***XX.com" like wise so on with another customer numbers too. can that be happened ?. I am sorry if I am asking for more . if this is not possible . any new ideas also appreciated ..

**gmayor** · 02-24-2017, 06:43 AM

I take it that if there is more than one invoice for the customer number in the folder, you want to add them all to the message?
In that case the following should work assuming I have understood your PDF file-naming.

Option Explicit

Sub Mail_Attachments()

Dim OutApp As Object
Dim OutMail As Object
Dim sAttach As String
Dim sPath As String
Dim iLastRow As Integer
Dim shtAddr As Worksheet
Dim xlSheet As Worksheet
Dim iRow As Long
Dim LastRow As Long

    Set xlSheet = ActiveWorkbook.Sheets("Email Body")
    xlSheet.Activate
    LastRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    LastRow = 3    'THIS LINE IS FOR TESTING ONLY!!!
    For iRow = 2 To LastRow
        sPath = xlSheet.Range("D" & iRow)
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = xlSheet.Range("C" & iRow)
            .Subject = xlSheet.Range("E" & iRow)
            sAttach = Dir$(sPath & "*.pdf")
            While Len(sAttach) <> 0
                If InStr(1, sAttach, xlSheet.Range("A" & iRow)) > 0 Then
                    .attachments.Add sPath & sAttach
                End If
                sAttach = Dir$()
                DoEvents
            Wend
            .HTMLBody = "<HTML><BODY>Please find invoice " & sAttach & " attached" _
                        & "<BR>" & "</HTML></BODY>"
            '        .Send   'or use .Display
            .Display
        End With
    Next iRow
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set xlSheet = Nothing
    Set shtAddr = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**Hudson** · 02-24-2017, 08:56 AM

Wow !!! this is fantastic mate as always you are the best .. thank you so much once again .. can you do me another favor please !! finally I don't want every email to send in my column. I want only those to be send when I say with the comment in last column " G" yes or No . if "yes" mail should go ,if" no" mail should not go . (that will act as a validation point for me) because I have 200 plus accounts and I don't send 200 emails , if a separate column with yes or no helps me a lot.

Can we do that please ?.

**gmayor** · 02-24-2017, 09:50 PM

Add lines as follows

For iRow = 2 To LastRow
        If xlSheet.Range("G" & iRow) = "yes" Then  'add this line

and

        End If  'add this line
    Next iRow

**Hudson** · 02-27-2017, 05:57 AM

Hey Gmayor , I tried and may be I was not doing it correctly . can you look and advice if I placed extra lines correctly.

 For iRow = 2 To LastRow
        If xlSheet.Range("G" & iRow) = "yes" Then 'add this line
        sPath = xlSheet.Range("D" & iRow)
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = xlSheet.Range("C" & iRow)
            .CC = xlSheet.Range("F" & iRow)
            .Subject = xlSheet.Range("E" & iRow)
            sAttach = Dir$(sPath & "*.pdf")
            While Len(sAttach) <> 0
                If InStr(1, sAttach, xlSheet.Range("A" & iRow)) > 0 Then
                    .attachments.Add sPath & sAttach
                End If
                sAttach = Dir$()
                DoEvents
            Wend
            .HTMLBody = "<HTML><BODY>Please find invoice " & sAttach & " attached" _
            & "<BR>" & "</HTML></BODY>"
             '        .Send   'or use .Display
            .Display
        
        End With
        End If
    Next iRow

**gmayor** · 02-27-2017, 06:24 AM

It looks OK based on what you have said (the colours don't work within the code tags) and assuming you have the text value "yes" in column G.

**Hudson** · 02-27-2017, 06:57 AM

I tried multiple times , nothing happening seem I am missing something.

attached is the macro file for your reference .

**gmayor** · 02-27-2017, 10:16 PM

Your message indicated that the field contained 'yes', whereas it contains 'Yes'. The function is case sensitive. If you want it not to be then you need to change the line to

If LCase(xlSheet.Range("G" & iRow)) = "yes" Then

**Hudson** · 02-28-2017, 07:55 AM

Hi Gmayor,

Its my mistake , I got it now and I did not notice case sensitive . code is working fine but it has small issue again it is picking up the incorrect attachments lets say . for example
1) (customer ID : 350000 picking attachment that has with 3500000)
2) (customer ID : 86000 picking attachment that has with 386000)
3) (customer ID : 50000 picking attachment that has with 3500000 and 8450000)
4) (customer ID : 320000 picking attachment that has with 3320000 )

This is again led me to create doubt on my macro and had to do it manually . can you help me please .sorry for killing your time again .

**gmayor** · 02-28-2017, 10:21 PM

It helps when you supply all the required information and not drip feed it.

Yes the macro will do as you indicate because it looks for a string within the filename that matches the column 1. That string will be in all those examples that you quote. If the filenames are separated by spaces as you said earlier e.g.

Sealing Invoice ***XX1- Customer 740000.pdf

Then we can look instead at the number after the final space e.g.

Option Explicit

Sub Mail_Attachments()

Dim OutApp As Object
Dim OutMail As Object
Dim sAttach As String
Dim sPath As String
Dim iLastRow As Integer
Dim shtAddr As Worksheet
Dim xlSheet As Worksheet
Dim iRow As Long
Dim LastRow As Long
Dim vFname As Variant
Dim sFName As String

    Set xlSheet = ActiveWorkbook.Sheets("Email Body")
    xlSheet.Activate
    LastRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    'LastRow = 3    'THIS LINE IS FOR TESTING ONLY!!!
    For iRow = 2 To LastRow 'Ignore the header row
        If LCase(xlSheet.Range("G" & iRow)) = "yes" Then
            sPath = xlSheet.Range("D" & iRow)
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = xlSheet.Range("C" & iRow)
                .Subject = xlSheet.Range("E" & iRow)
                sAttach = Dir$(sPath & "*.pdf")
                While Len(sAttach) <> 0
                    vFname = Split(sAttach, Chr(32)) 'Split the filename by spaces
                    sFName = vFname(UBound(vFname)) 'Look at the last item
                    If sFName = xlSheet.Range("A" & iRow) & ".pdf" Then 'check if the last item matches the cell value + the extension
                        .attachments.Add sPath & sAttach
                    End If
                    sAttach = Dir$()
                    DoEvents
                Wend
                .HTMLBody = "<HTML><BODY>Please find invoice " & sAttach & " attached" _
                            & "<BR>" & "</HTML></BODY>"
                '        .Send   'or use .Display
                .Display
            End With
        End If
    Next iRow
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set xlSheet = Nothing
    Set shtAddr = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**Hudson** · 03-02-2017, 08:07 AM

Thank you so much . this is now working fantastic .. appreciate your efforts .

This is a brilliant move , splitting the file name and attaching it .

vFname = Split(sAttach, Chr(32)) 'Split the filename by spaces

Excellent mate . as always you are the champion

.

Thread: Sending Emails with attachments if criteria met

Thread Tools

Display

Sending Emails with attachments if criteria met

Posting Permissions