Send Mail With Outlook (Enviar Email com Outlook)
Enviado: 26 Out 2018 às 21:36
Boa Noite Pessoal,
Estou tentando criar um código para envio de email pelo excel. Porém, não estou conseguindo resolver as inconsistências do código, poderiam ajudar por favor?
Erros que detectei, ele informa que foi enviado o email mesmo sem enviar nenhum email.
Next sem For... também não sei como resolver esse problema
E em alguns testes o Loop do script falha não sei porque.
Segue abaixo o código:
Estou tentando criar um código para envio de email pelo excel. Porém, não estou conseguindo resolver as inconsistências do código, poderiam ajudar por favor?
Erros que detectei, ele informa que foi enviado o email mesmo sem enviar nenhum email.
Next sem For... também não sei como resolver esse problema
E em alguns testes o Loop do script falha não sei porque.
Segue abaixo o código:
Código: Selecionar todos
Desde já muito obrigado a todos.Public Sub EnviarEmail()
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
'Referência à biblioteca do Outlook
Dim outapp As Outlook.Application
Dim outmail As Outlook.MailItem
Dim i As Integer, row As Integer
Dim ContactRow, LastRow, SentCounter As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Mailing")
i = 16
row = ws.Range("B" & Rows.Count).End(xlUp).row
'Convertendo "," para ";"
Range("C16:E16").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:=",", Replacement:=";", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Inicializando o Aplicativo do MS-Outlook
Set outapp = New Outlook.Application
'Do While i <= row
If ws.Range("L" & i).Value <> Empty Then GoTo NextRow
'Novo Email
Set outmail = outapp.CreateItem(olMailItem)
With outmail
.Display
.To = ws.Range("C" & i).Value
.CC = ws.Range("E" & i).Value
.BCC = ws.Range("E" & i).Value
.Subject = ws.Range("F" & i).Value
.Body = Range("C4").Value
If ws.Range("G" & i).Value <> "" Then
.Attachments.Add ws.Range("G" & i).Value
End If
If ws.Range("H" & i).Value <> "" Then
.Attachments.Add ws.Range("H" & i).Value
End If
If ws.Range("I" & i).Value <> "" Then
.Attachments.Add ws.Range("I" & i).Value
End If
If ws.Range("J" & i).Value <> "" Then
.Attachments.Add ws.Range("J" & i).Value
End If
If ws.Range("K" & i).Value <> "" Then
.Attachments.Add ws.Range("K" & i).Value
End If
.Importance = olImportanceHigh
'.Send
End With
SentCounter = SentCounter + 1
ws.Range("L" & i).Value = Now 'Set Send Date & Time
NextRow:
Next i
'Liberar Memória
Set outmail = Nothing
Set outapp = Nothing
Set ws = Nothing
Set wb = Nothing
MsgBox SentCounter & " Emails have been sent"
End Sub