-
Jan 4th, 2018, 05:50 AM
#1
Thread Starter
Hyperactive Member
[RESOLVED] Attach multiple reports to recipients in one email
Hi..I have the code below to email out reports to users. Some users could have multiple reports which are listed in column A in each cell. So if one user has say 10 reports it is sending them 10 emails. I would like to send one email with the 10 attachments. Can someone please advise what I need to change or add to the code. Thanks
Code:
Sub Email()
mypath = "C:\Reports\"
Set oboutlook = CreateObject("outlook.application")
For Each cel In Range("a2:a500")
If IsEmpty(cel) Then Exit For
Set nm = oboutlook.CreateItem(0) ' new mail item
With nm
.To = cel.Offset(, 1)
.Attachments.Add mypath & cel & ".xlsx"
.Body = "Please find attached reports"
.Subject = "Reports"
.Save
.Send
' .Close
End With
Next
End Sub
-
Jan 4th, 2018, 06:12 AM
#2
Re: Attach multiple reports to recipients in one email
there could be several approaches to this
assuming the email addresses are in column b, you could sort or filter by email address from that column, you could test manually with your workbook to see if you can get appropriately filtered lists
personally i would prefer to use ADO, with SQL to generate a recordset from the worksheet, of unique users (email addresses) then loop that recordset to generate a second recordset for each user, in turn, with all their attachments to email
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 4th, 2018, 06:26 AM
#3
Thread Starter
Hyperactive Member
Re: Attach multiple reports to recipients in one email
Originally Posted by westconn1
personally i would prefer to use ADO, with SQL to generate a recordset from the worksheet, of unique users (email addresses) then loop that recordset to generate a second recordset for each user, in turn, with all their attachments to email
Hi Pete...can you please help me with the code for this. I don't really want to be touching the email address file as it could change frequently.
-
Jan 4th, 2018, 07:10 AM
#4
Thread Starter
Hyperactive Member
Re: Attach multiple reports to recipients in one email
Last edited by fusion001; Jan 4th, 2018 at 08:12 AM.
-
Jan 4th, 2018, 03:05 PM
#5
Re: [RESOLVED] Attach multiple reports to recipients in one email
pls post your solution to assist others who find this tread
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 5th, 2018, 08:39 AM
#6
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
This is the code
Code:
Sub email()
Dim sht As Worksheet
Dim myfiles() As String
Set sht = Sheets("sheet1") ' change to suit
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row, if you do not have header row change to xlno
myfilepath = "c:\Reports\"
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(0)
rw = 0 ' change to 1 if you want to have a header row
Do Until IsEmpty(sht.Cells(rw + 1, 2))
rw = rw + 1
With myMessage
.To = sht.Cells(rw, 2)
.Subject = "Reports"
'.BodyFormat = olFormatHTML
.body = "Please find attached reports"
myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")
For a = 0 To UBound(myfiles)
ext = ".xlsx"
.Attachments.Add myfilepath & myfiles(a) & ext
Next
If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
.send
Set myMessage = myOutlook.CreateItem(0)
End If
End With
Loop
End Sub
Code worked fine but one issue I have is that if if on the distribution list there is a report which doesn't exist in the folder I get a debug saying file or path doesn't exist. What code do I need to add to skip any reports not found in the folder? Also it would be useful if we can get an exceptions list of those reports not found if it is an easy set up. Thanks
-
Jan 5th, 2018, 03:27 PM
#7
Re: [RESOLVED] Attach multiple reports to recipients in one email
Code:
For a = 0 To UBound(myfiles)
ext = ".xlsx"
if len(dir(myfilepath & myfiles(a) & ext)) > 0 then
.Attachments.Add myfilepath & myfiles(a) & ext
else
errlist = errlist & .to & " - " & myfilepath & myfiles(a) & ext & vbnewline
end if
Next
of course if there is only one attachment and the file is missing then an email without attachments will be sent,
before end sub you can have a msgbox or write to file errlist so you can see which reports were not found,
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 5th, 2018, 03:43 PM
#8
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Thanks Pete. There may be recipients who will receive multiple reports so they should get all the reports even if there are some reports missing however if there is only one report for a recipient and the report is missing then I don't want an email to be sent for that recipient. The code should just skip to the next recipient.
-
Jan 5th, 2018, 03:50 PM
#9
Re: [RESOLVED] Attach multiple reports to recipients in one email
that would need a rewrite of the code to change the order things are done, some stuff should be changed anyway, i will look later
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 5th, 2018, 09:42 PM
#10
Re: [RESOLVED] Attach multiple reports to recipients in one email
Code:
Set sht = Sheets("sheet1") ' change to suit
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row, if you do not have header row change to xlno
myfilepath = "c:\Reports\"
Set myOutlook = GetObject(, "Outlook.Application")
ext = ".xlsx"
rw = 0 ' change to 1 if you want to have a header row
Do Until IsEmpty(sht.Cells(rw + 1, 2))
myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")
fnd = False
For a = 0 To UBound(myfiles)
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
fnd = True: Exit For ' some valid report path found
End If
Next
If fnd Then
rw = rw + 1
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
Set myMessage = myOutlook.CreateItem(0)
With myMessage
.To = sht.Cells(rw, 2)
.Subject = "Reports"
.body = "Please find attached reports"
For a = 0 To UBound(myfiles)
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
.Attachments.Add myfilepath & myfiles(a) & ext
Else
errlist = errlist & .To & " - " & myfilepath & myfiles(a) & ext & vbNewLine
End If
Next
.send
End With
End If
Else
errlist = errlist & "no valid report found for " & Cells(rw, 2)
End If
Loop
i have not really changed what it does, just changed the order it does things, i have not tested at all, this now checks each email to see if there is any valid report path at all and checks each report path to see if it is valid
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 8th, 2018, 06:20 AM
#11
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Thanks for that Pete. I get an "Application-defined or object-defined error" on
Code:
myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")
.
-
Jan 8th, 2018, 03:19 PM
#12
Re: [RESOLVED] Attach multiple reports to recipients in one email
i made a couple of minor changes
Code:
Set sht = Sheets("sheet1") ' change to suit
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row, if you do not have header row change to xlno
myfilepath = "c:\Reports\"
Set myOutlook = GetObject(, "Outlook.Application")
ext = ".xlsx"
rw = 1 ' change to 2 if you want to have a header row
Do Until IsEmpty(sht.Cells(rw, 2))
myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")
fnd = False
For a = 0 To UBound(myfiles)
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
fnd = True: Exit For ' some valid report path found
End If
Next
If fnd Then
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
Set myMessage = myOutlook.CreateItem(0)
With myMessage
.To = sht.Cells(rw, 2)
.Subject = "Reports"
.body = "Please find attached reports"
For a = 0 To UBound(myfiles)
If Len(Dir(myfilepath & myfiles(a) & ext)) > 0 Then
.Attachments.Add myfilepath & myfiles(a) & ext
Else
errlist = errlist & .To & " - " & myfilepath & myfiles(a) & ext & vbNewLine
End If
Next
.send
End With
End If
Else
errlist = errlist & "no valid report found for " & Cells(rw, 2)
End If
rw = rw + 1
Loop
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 9th, 2018, 06:13 AM
#13
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi Pete...multiple emails with individual reports are now being generated rather than just one email per recipient. Also the error list is not being generated.
-
Jan 9th, 2018, 06:53 AM
#14
Re: [RESOLVED] Attach multiple reports to recipients in one email
post a sample workbook, as i was only working with the code as provided in post #6 and assumed that the data matched what the code was doing
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 9th, 2018, 07:03 AM
#15
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi Pete...in the workbook all I have is in column A is the report name and in column B is the email address.
i used the code in post #12
For example
1234 FB@g.com
2345 FB@g.com
7777 TT@h.com
1111 FB@g.com
-
Jan 9th, 2018, 03:38 PM
#16
Re: [RESOLVED] Attach multiple reports to recipients in one email
ok, i can see why there is the problem
myfiles = Split(Sheets("sheet1").Cells(rw, 1), ";")
this line indicated that all reports were in on cell, separated by ;
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row, if you do not have header row change to xlno
this line, looks like something i have posted previously, was to sort the email addresses, which you indicated in post #3 you did not want to do
though you could save the workbook then run the code and close without saving
you can test this, i did not get time to test
Code:
Dim sht As Worksheet
Dim myfiles() As String
Set sht = Sheets("sheet1") ' change to suit
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row, if you do not have header row change to xlno
myfilepath = "c:\Reports\"
ext = ".xlsx"
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(0)
rw = 0 ' change to 1 if you want to have a header row
Do Until IsEmpty(sht.Cells(rw + 1, 2))
rw = rw + 1
With myMessage
.To = sht.Cells(rw, 2)
.Subject = "Reports"
.body = "Please find attached reports"
If Len(Dir(myfilepath & sht.Cells(rw, 1) & ext)) > 0 Then
.attachments.Add myfilepath & sht.Cells(rw, 1) & ext
Else
errlist = errlist & "Path does not exist to " & Cells(rw, 1) & " for " & Cells(rw, 2)
End If
If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
If .attachments.Count > 0 Then
.send
Else
errlist = errlist & "No valid reports found for " & Cells(rw, 2)
.Close 1 ' discard mail item
End If
Set myMessage = myOutlook.CreateItem(0)
End If
End With
Loop
i am sure this is some code a wrote a while ago, just with checking for file validity added
if i was going to redo it, i would use ADO
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 10th, 2018, 05:14 AM
#17
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi Pete...only one email is sent per recipient which is great but the error messages are not generated.
-
Jan 10th, 2018, 03:06 PM
#18
Re: [RESOLVED] Attach multiple reports to recipients in one email
did you check if errlist variable contains any value?
before end sub
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 11th, 2018, 05:02 AM
#19
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
That's perfect. Thanks very much.
Last edited by fusion001; Jan 11th, 2018 at 05:50 AM.
-
Jan 11th, 2018, 10:44 AM
#20
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
I have one question which is not really directly related to this thread but is linked. I have a added a variable to the email subject so the user can add the subject title each month.
I have added another piece of code which is called by the main sub above to let a group of people know that the reports have been emailed out. Is there a way to link the email subject title to the variable in the first code?
Thanks
-
Jan 11th, 2018, 03:18 PM
#21
Re: [RESOLVED] Attach multiple reports to recipients in one email
Is there a way to link the email subject title to the variable in the first code?
of course
you could use an inputbox
Code:
monthtitle = InputBox("Enter a title for email cubject")
change the subject line to suit
Code:
.subject = "Reports for " & monthtitle
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 11th, 2018, 04:22 PM
#22
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Is it not possible to use the subject title from the first set of code rather than have to create another input box for the email notification?
-
Jan 12th, 2018, 02:37 AM
#23
Re: [RESOLVED] Attach multiple reports to recipients in one email
Is it not possible to use the subject title
probably,
so the user can add the subject title each month.
but i thought you wanted the user to put additional information on a month to month basis, an inputbox seemed preferable to having the user change the code, or you had some other idea?
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 12th, 2018, 04:19 AM
#24
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi Pete...sorry for the confusion. What I have done is added an input box in the main code post #16.
Then I have added another sub to email out specific people to notify that the reports have been emailed from the first set of code. So rather than have another input box for this second part of the code is there a way to pick up the subject from the first code? I hope this makes sense.
-
Jan 12th, 2018, 06:33 AM
#25
Re: [RESOLVED] Attach multiple reports to recipients in one email
you can pass the variable to the second sub as parameter when you call it
something like
Code:
sub second(subject as string)
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jan 12th, 2018, 06:52 AM
#26
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Sorted. Thanks.
Added
Code:
Public varfolder2 As String
Last edited by fusion001; Jan 12th, 2018 at 10:58 AM.
-
Mar 28th, 2018, 09:20 AM
#27
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi..rather than start a new thread I thought I'd add to this one. The above code works perfectly but what I need to do is attach a word document to the emails. The issue I have is that if an email recipient has say 10 reports it is adding the word document 10 times rather than just the once. I just want one word document per email plus all the other reports. Can anyone help with this please?
Code:
.Attachments.Add myfilepath & "Letter.docx"
-
Mar 28th, 2018, 03:30 PM
#28
Re: [RESOLVED] Attach multiple reports to recipients in one email
Code:
If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
' i reckon you would have to add it here
If .attachments.Count > 0 Then
' or here, depending on your requiremens
.send
Else
errlist = errlist & "No valid reports found for " & Cells(rw, 2)
.Close 1 ' discard mail item
End If
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Mar 29th, 2018, 03:43 AM
#29
Thread Starter
Hyperactive Member
Re: [RESOLVED] Attach multiple reports to recipients in one email
Hi...Thanks so much for that
Last edited by fusion001; Mar 29th, 2018 at 03:46 AM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|