Send Mail With Outlook (Enviar Email com Outlook)


#1

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:

`Texto pré-formatado`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`Texto pré-formatado`

Desde já muito obrigado a todos.


#2

@wallacerodrigo57, nesta parte do código, caso a célula atual seja vazia, redireciona a execução para um local chamado NextRow. No trecho NextRow:

NextRow:
    Next i

Aqui é encontrado a chamada para Next i, no entanto, nenhum For foi inicializado. Daí o erro. A instrução Do é encerrada em Loop e não em Next.


#3

Se entendi, acho que deveria ficar mais ou menos assim:

NextRow:
i = i +1
Loop