Excel VBA - Envio em Massa de Email - Excel

[Yuri Watzech]

Bom dia a todos!
 

Gostaria de tirar uma dúvida e entender o que estou fazendo de errado no meu código.
Estou criando uma Macro para enviar emails em massa para destinatários diferentes, cada um com um texto.

Meu problema esta sendo que ele esta enviando somente para a primeira linha da planilha, não está repetindo para os demais.

Imagino que seja um Loop faltante, mas pelo fato de ter um "Next i", entendo que funcionaria....

 

Alguém pode me ajudar? Obrigado!!!

 

Obs: São 4 Emails diferentes (4 Linhas)

Código:

 

Sub Enviar_Email()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    On Error Resume Next
    
     For i = 1 To 4
     
        If Exemplo1.Range("F" & i + 2).Value <> "Ok" Then
             With OutlookMail
                .To = Exemplo1.Range("F" & i + 2).Value
                .CC = Exemplo1.Range("G" & i + 2).Value
                .BCC = Exemplo1.Range("H" & i + 2).Value
                .Subject = Exemplo1.Range("E" & i + 2).Value
                .HTMLBody = Exemplo1.Range("L" & i + 2).Value
                .Send
                '.Display 'Use .Send para enviar o email direto sem exibir na tela''
                
             End With
        End If
    Next i
    
    On Error GoTo 0
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub
 

 

 

Segue print da planilha:

 

Obrigado desde já!!! =)

[Midori]

Altere o For para iniciar na linha 3 e remova o adicional 2.

 

For i = 3 To 6
     
        If Exemplo1.Range("F" & i).Value <> "Ok" Then
             With OutlookMail
             

...

 

[Yuri Watzech]

@olliver.soul tentei aqui substituir o código, continuou mandando apenas para o primeiro destinatário.......
O código ficou assim:

'Email automático em massa para fornecedores - Autor: Yuri Watzech'

Sub Enviar_Email()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    On Error Resume Next
    
     For i = 3 To 6
     
        If Exemplo1.Range("F" & i).Value <> "Ok" Then
             With OutlookMail
                .To = Exemplo1.Range("F" & i).Value
                .CC = Exemplo1.Range("G" & i).Value
                .BCC = Exemplo1.Range("H" & i).Value
                .Subject = Exemplo1.Range("E" & i).Value
                .HTMLBody = Exemplo1.Range("L" & i).Value
                .Send
                '.Display 'Use .Send para enviar o email direto sem exibir na tela''
                
             End With
        End If
    Next i
    
    On Error GoTo 0
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub
 

 

=/

[Midori]

Já tentou executar sem as instruções On Error?

 

Se for algum erro ficará mais fácil identificar o problema.

 

Ou então tente colocar o "Set OutlookMail... / Set OutlookMail = Nothing" dentro do For.

[Yuri Watzech]

Tentei tudo isso ai =/

 

Infelizmente não deu haha 

 

No idea kkk  tks bro! @olliver.soul