Vba excel enviar email

[Kelvim]

Boa tarde

 

Eu tenho um código que envia e-mail através de VBA EXCEL pelo Outlook.

porém quando chega em um numero X de vezes que ele está repetindo ele apresenta erro, abaixo segue o print.

Não existe nenhuma informação errada.
Se eu envio quantidades menores ele envia.

Quando envio mais quantidade ele apresenta erro.

Gostaria de saber o que poderia ser.

Sub enviar_planilha_corpo_email()
Dim QTD As Variant
Dim pdv(1 To 50) As Variant
Dim resultado As VbMsgBoxResult
    
    For i = 1 To 50
    pdv(i) = Sheets("PDV").Cells(i, 1)
    Next
resultado = MsgBox("Enviar email?", vbYesNo, "Enviar email")
If resultado = vbYes Then
QTD = InputBox("Informe a quantida de Fornecedores")
    
 For i = 1 To QTD
    
    Application.ScreenUpdating = False
    
    Sheets("MENSAG").Select
    Range("A1", "O70").Select
    
    Selection.Copy
    
 
    ActiveWorkbook.EnvelopeVisible = True
'On Error Resume Next
    With ActiveSheet.MailEnvelope
        .Introduction = "Caro" & " " & Sheets("PDV").Cells(i, 1)
        .Item.To = Sheets("PDV").Cells(i, 2)
        '.Item.cc = ""
        .Item.Subject = "COMUNICADO" & "  " & Date
        .Item.Send
    End With
Application.ScreenUpdating = True
Next
Else
End If
End Sub

[Basole]

Em 17/06/2016 às 15:44, Kelvim disse:

Não existe nenhuma informação errada.
Se eu envio quantidades menores ele envia.

Quando envio mais quantidade ele apresenta erro.

 

 

Eu não uso o outlook e não tem como testar.

Mas se não há erros com o codigo, isso pode estar ocorrendo, porque o provedor de emails está classificando como span, na medida que voce envia os emails em lotes. 

[Kelvim]

Boa noite

 

Eu consegui resolver o problema.

 

Eu fiz um código para receber através de vetor em uma variável tipo public 

 

Depois apenas utilizei na hora de enviar o e-mail.

 

Segue abaixo.

 

Public ender_email(1 To 50) As Variant
Public ender_email_cop(1 To 50) As Variant
Public PDV(1 To 50) As Variant
Sub enderecos()
        i = 1
        Do While Sheets("PDV").Cells(i, 2).Value <> Empty
        PDV(i) = Sheets("PDV").Cells(i, 2)
        ender_email(i) = Sheets("PDV").Cells(i, 3)
        ender_email_cop(i) = Sheets("PDV").Cells(i, 5)
        i = i + 1
        Loop
End Sub