preseb
02-23-2011, 05:52 AM
I have this get simple macro for sending out files.
Column A - has the persons name - for my reference.
Column B - has their first name - so when it put in the body, it address' them with their first name
Column C is their e-mail
Column D - subject
Column E - is the path and the file to be attached
Column F - body of the message
what I would like to change is, there are a lot of instances where 1 person may recived mutiple reports. The way I am handeling it now is that person woulds get a bunch of e-mails.
I would like to change it so that if a person is to recived multiple attachments, that they would receive 1 e-mail with multiple attachments.
Sub Mailer()
Dim rngMailInfo As Range, rngCell As Range
Dim objApp As Object
Dim objMail As Object
Set rngMailInfo = Intersect(ActiveSheet.UsedRange, Range("B4:F" & Rows.Count))
Set objApp = CreateObject("Outlook.Application")
For Each rngCell In rngMailInfo.Resize(, 1)
On Error Resume Next
Set objMail = objApp.CreateItem(0)
With objMail
.To = rngCell(, 2).Text
.Subject = rngCell(, 3).Text
.Body = "" & rngCell.Text & vbCrLf & rngCell(, 5).Text
.Attachments.Add rngCell(, 4).Text
.Save
End With
Set objMail = Nothing
On Error GoTo 0
Next rngCell
Set objApp = Nothing
End Sub
thank you for your help
Column A - has the persons name - for my reference.
Column B - has their first name - so when it put in the body, it address' them with their first name
Column C is their e-mail
Column D - subject
Column E - is the path and the file to be attached
Column F - body of the message
what I would like to change is, there are a lot of instances where 1 person may recived mutiple reports. The way I am handeling it now is that person woulds get a bunch of e-mails.
I would like to change it so that if a person is to recived multiple attachments, that they would receive 1 e-mail with multiple attachments.
Sub Mailer()
Dim rngMailInfo As Range, rngCell As Range
Dim objApp As Object
Dim objMail As Object
Set rngMailInfo = Intersect(ActiveSheet.UsedRange, Range("B4:F" & Rows.Count))
Set objApp = CreateObject("Outlook.Application")
For Each rngCell In rngMailInfo.Resize(, 1)
On Error Resume Next
Set objMail = objApp.CreateItem(0)
With objMail
.To = rngCell(, 2).Text
.Subject = rngCell(, 3).Text
.Body = "" & rngCell.Text & vbCrLf & rngCell(, 5).Text
.Attachments.Add rngCell(, 4).Text
.Save
End With
Set objMail = Nothing
On Error GoTo 0
Next rngCell
Set objApp = Nothing
End Sub
thank you for your help