-
Mar 31st, 2017, 03:35 AM
#1
Thread Starter
Hyperactive Member
Sending attachments with emails
I have a code which I want to use to send emails with attachments. I have a report which has the report name in column A and the recipient email address in column B. It appears that it is missing off every second line, so it sends an email to recipient on row 1, row 3, row 5 etc. I'm not sure why this is happening. Can anyone spot something on this code? Thanks
Code:
Sub email()
Dim sht As Worksheet
Dim myfiles() As String
'Dim strEmailText As String
Set sht = Sheets("sheet1")
sht.UsedRange.Sort sht.Range("b:b"), , , , , , , xlNo ' xlyes for header row
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
.SentOnBehalfOfName = "JM@hm.com"
.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"
'If Len(Dir(myfilepath & myfiles(a) & ext)) = 0 Then MsgBox myfilepath & myfiles(a) & ext & " not found"
.Attachments.Add myfilepath & myfiles(a) & ext
Next
If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
.Attachments.Add myfilepath & "Letter.docx"
.Send
Set myMessage = myOutlook.CreateItem(0)
End If
rw = rw + 1
End With
Loop
'oboutlook.Quit
'Set oboutlook = Nothing
End Sub
-
Mar 31st, 2017, 04:14 AM
#2
Re: Sending attachments with emails
you have rw = rw +1 in 2 places, should only be in one
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 31st, 2017, 04:20 AM
#3
Thread Starter
Hyperactive Member
Re: Sending attachments with emails
Originally Posted by westconn1
you have rw = rw +1 in 2 places, should only be in one
Thanks so much.
-
Mar 31st, 2017, 04:57 AM
#4
Thread Starter
Hyperactive Member
Re: Sending attachments with emails
Is there a piece of code that I can add to skip any rows where it doesn't find a report? At the moment each time a report is not found the code stops. Thanks
-
Mar 31st, 2017, 06:04 AM
#5
Re: Sending attachments with emails
you could try like
Code:
Do Until IsEmpty(sht.Cells(rw + 1, 2))
rw = rw + 1
if not isempty(sht.Cells(rw, 1)) then
With myMessage
.SentOnBehalfOfName = "JM@hm.com"
.To = sht.Cells(rw, 2)
.Subject = "Reports"
'.BodyFormat = olFormatHTML
.body = "Please find attached reports"
myfiles = Split(sht.Cells(rw, 1), ";")
For a = 0 To UBound(myfiles)
ext = ".xlsx"
'If Len(Dir(myfilepath & myfiles(a) & ext)) = 0 Then MsgBox myfilepath & myfiles(a) & ext & " not found"
.Attachments.Add myfilepath & myfiles(a) & ext
Next
If Not sht.Cells(rw, 2) = sht.Cells(rw + 1, 2) Then
.Attachments.Add myfilepath & "Letter.docx"
.Send
Set myMessage = myOutlook.CreateItem(0)
End If
End With
end if
Loop
i have not checked all the code, so test carefully
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
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
|