[SOLVED:] Sending Emails with attachments if criteria met

1 Attachment(s)

Sending Emails with attachments if criteria met

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.

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.

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.

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 ?.

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

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 ?...

Code:

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

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.

Code:

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

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

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.

Code:

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

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 ?.

Add lines as follows

Code:

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

and

Code:

End If 'add this line Next iRow

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

Code:

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

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.

1 Attachment(s)

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

attached is the macro file for your reference .

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

Code:

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

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 .

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.

Code:

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

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 :friends:.