PDA

View Full Version : Macro to send e-mail for different recipients with different messages



tomasmello27
11-24-2017, 10:14 AM
Good afternoon!

I'm trying to create to create a macro that automatically sends e-mails to various addresses, with different messages ('cause each message contains the name of the person).

In an Excel sheet (called "mensagem"), I have the e-mail addresses in column F and the messages in column G. However, all the addresses come from formulas that get them from another sheet (the database of clientes), therefore some clients do not have an e-mail address. I tried to create a macro that reads all the rows and skips those that do not contain an e-mail address. Just to give you an idea, this is part of my table:

21044

This is the code I wrote, however it is not working. I'm suspecting it's because all my results in row F come from formulas (which can result in the e-mail address or in 0), so the SpecialCells I'm using is wrong. How can I fix that so I can identify the rows different than 0? (I already fixed those with #N/D so they result in 0 as well)


Sub enviaremail()Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set sh = Sheets("Mensagem")


Set OutApp = CreateObject("Outlook.Application")


For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)


Set rng = sh.Cells(cell.Row, 1).Range("G1")

If cell.Value Like "#0" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Antecipação de Parcelas - Teriva Imperatriz"
.Body = cell.Offset(0, 1).Value

.Send
End With


Set OutMail = Nothing
End If
Next cell


Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Kenneth Hobs
11-24-2017, 09:51 PM
Maybe:

Sub enviaremail() Dim OutApp As Object, OutMail As Object
Dim sh As Worksheet, Cell As Range
Dim rng As Range

Set sh = Sheets("Mensagem")


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set OutApp = CreateObject("Outlook.Application")

For Each Cell In sh.Range("F2", sh.Cells(Rows.Count, "F").End(xlUp))
'Set rng = sh.Cells(cell.Row, 1).Range("G1") 'Same as cell.offset(,1)
Set rng = Cell.Offset(, 1)

If Cell.Value Like "*@*" And rng <> "" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cell.Value
.Subject = "Antecipação de Parcelas - Teriva Imperatriz"
.Body = rng.Value
.Send
End With
Set OutMail = Nothing
End If
Next Cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

greyangel
11-29-2017, 07:41 AM
You could just insert code that would ignore all errors and just move on to the next cell.


Sub enviaremail()Dim OutApp As Object
On error resume next
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set sh = Sheets("Mensagem")


Set OutApp = CreateObject("Outlook.Application")


For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)


Set rng = sh.Cells(cell.Row, 1).Range("G1")

If cell.Value Like "#0" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Antecipação de Parcelas - Teriva Imperatriz"
.Body = cell.Offset(0, 1).Value

.Send
End With


Set OutMail = Nothing
End If
Next cell


Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
On error goto 0
End Sub

tomasmello27
12-07-2017, 11:50 AM
It worked, thank you a lot!

greyangel
12-07-2017, 11:52 AM
No problem glad I could help. Please mark this thread as solved.

thank you