PDA

View Full Version : [SOLVED:] 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 :friends:.