- 22 Out 2021 às 12:56
#67664
Tenho uma Rotina de email mais quando chega na linha 14 para envio a esse destinatário ele da essa msg nessa linha do vba " .To = Worksheets("Envio Email").Cells(i, 17) " segue abaixo
Abaixo Rotina
Sub EnvioEmailColetiva()
Dim iTotalLinhas As Long
Dim i As Long
Dim EnviarPara As String
Application.ScreenUpdating = False
iTotalLinhas = Worksheets("Envio Email").Cells(Worksheets("Envio Email").Rows.Count, 15).End(xlUp).Row
Worksheets("Envio Email").Select
For i = 2 To iTotalLinhas
EnviarPara = Worksheets("Envio Email").Cells(i, 16)
If EnviarPara <> "" Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = Worksheets("Envio Email").Cells(i, 17) 'NESSA LINHA DA ERRO QUANDO
.CC = ""
.BCC = ""
.Subject = Worksheets("Envio Email").Cells(i, 15) & " - Férias Coletivas " & Format(Worksheets("Envio Email").Cells(2, 20), "dd-mm-yyyy")
.HTMLBody = Worksheets("Envio Email").Cells(i, 18) _
& "<br><br><br><b>Rota de Aprovação:</b>" & "<br>" & RangetoHTML(Range("AG1:AH6")) & "<br><br>Abraços" & "<br><br>Atte," & "<br><br><b>Thiago Pinheiro
Anexo = Worksheets("Envio Email").Cells(i, 19)
.Attachments.Add Anexo
.Send
End With
End If
Next i
Worksheets("Relatório Férias").Select
ActiveSheet.ShowAllData
MsgBox "E-mail Enviado"
Application.ScreenUpdating = True
End Sub
Como corrigir
Abaixo Rotina
Sub EnvioEmailColetiva()
Dim iTotalLinhas As Long
Dim i As Long
Dim EnviarPara As String
Application.ScreenUpdating = False
iTotalLinhas = Worksheets("Envio Email").Cells(Worksheets("Envio Email").Rows.Count, 15).End(xlUp).Row
Worksheets("Envio Email").Select
For i = 2 To iTotalLinhas
EnviarPara = Worksheets("Envio Email").Cells(i, 16)
If EnviarPara <> "" Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = Worksheets("Envio Email").Cells(i, 17) 'NESSA LINHA DA ERRO QUANDO
.CC = ""
.BCC = ""
.Subject = Worksheets("Envio Email").Cells(i, 15) & " - Férias Coletivas " & Format(Worksheets("Envio Email").Cells(2, 20), "dd-mm-yyyy")
.HTMLBody = Worksheets("Envio Email").Cells(i, 18) _
& "<br><br><br><b>Rota de Aprovação:</b>" & "<br>" & RangetoHTML(Range("AG1:AH6")) & "<br><br>Abraços" & "<br><br>Atte," & "<br><br><b>Thiago Pinheiro
Anexo = Worksheets("Envio Email").Cells(i, 19)
.Attachments.Add Anexo
.Send
End With
End If
Next i
Worksheets("Relatório Férias").Select
ActiveSheet.ShowAllData
MsgBox "E-mail Enviado"
Application.ScreenUpdating = True
End Sub
Como corrigir