Página 1 de 1

Dúvida no campo .to para Encamihar Email

Enviado: Seg Fev 10, 2020 3:01 pm
por fao17
Boa tarde.
Preciso de um código onde encaminha somente um email para endereços de acordo com uma coluna.
No meu código o campo "para" preenche somente com o conteúdo da primeira célula.
Onde está meu erro?

Código: Selecionar todos

Sub EnviarEmail()
Dim OutApplication As Object
Dim nEmail As Object
Dim UltCel As Range
Dim Resultado As Long

Application.ScreenUpdating = False
Set OutApplication = CreateObject("Outlook.Application")
Set nEmail = OutApplication.CreateItem(olMailItem)

Resultado = 0
'Sheets("Email").Select

'Set UltCel = ActiveSheet.Range("A1048576").End(xlUp)
'UltCel.Select
Range("I14").Select

Do While ActiveCell.row >= ""
    
    Resultado = ActiveCell.Value
    ActiveCell.Offset(-1, 0).Select
    
Loop

With nEmail
.to = Resultado
'.CC = 
'.BCC = 
.Subject = 
.HtmlBody = "

.display

End With
Application.ScreenUpdating = True

End Sub


Re: Dúvida no campo .to para Encamihar Email

Enviado: Ter Fev 11, 2020 7:41 am
por Reinaldo
A variavel Resultado não pode ser Long (numerica), deve ser String (Texto)
Para enviar a todos os valores encontrado experimente alterar o trecho conforme abaixo

Código: Selecionar todos

...
Do While ActiveCell.Row <> ""
    Resultado = Resultado & ";" & ActiveCell.Value
    ActiveCell.Offset(-1, 0).Select
Loop
If VBA.Right(Resultado, 1) = ";" Then Resutado = VBA.Mid(Resultado, 1, Len(Resultado) - 1)
...
Para enviar um a um experimente

Código: Selecionar todos

Sub EnviarEmail()
Dim OutApplication As Object
Dim nEmail As Object
Dim Resultado As String

Application.ScreenUpdating = False
Set OutApplication = CreateObject("Outlook.Application")
Set nEmail = OutApplication.CreateItem(olMailItem)

Range("I14").Select

Do While ActiveCell.Row <> ""
    Resultado = ActiveCell.Value
        With nEmail
            .to = Resultado
            '.CC =
            '.BCC =
            .Subject =
            .HtmlBody = ""
            .display
        End With
    ActiveCell.Offset(-1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub