preseb
07-12-2011, 08:23 AM
I use the macro below to e-mail a list of people all in seperate e-mails. can anyone help change it so that it uses that same list but creates 1 e-mail that everyone is on?
The subject and body will be located on row 4
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
The subject and body will be located on row 4
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