Este fórum está sendo desativado

[AndreAnjos]

Olá, pessoal. Boa tarde.

Gostaria de saber qual macro eu utilizo para enviar um e-mail. Eu tenho um arquivo x salvo na pasta de rede, quero que esse arquivo seja enviado para aproximadamente 40 destinatários com a seguinte mensagem:

Prezados, boa tarde.

Segue prévia de Revenue.


Att,

(Assinatura)

A minha intenção é criar essa rotina dentro do próprio arquivo que será enviado por e-mail, pois dentro dele existem uma série de outras rotinas que são acionadas todos os dias quando rodo uma macro, então ao criar essa rotina de enviar e-mail queria colocar no final da utima macro que tenho no meu arquivo uma Call EnviarEmail, por exemplo.

[AndreAnjos]

Olá, pessoal. Boa tarde.

Gostaria de saber qual macro eu utilizo para enviar um e-mail. Eu tenho um arquivo x salvo na pasta de rede, quero que esse arquivo seja enviado para aproximadamente 40 destinatários com a seguinte mensagem:

Prezados, boa tarde.

Segue prévia de Revenue.


Att,

(Assinatura)

A minha intenção é criar essa rotina dentro do próprio arquivo que será enviado por e-mail, pois dentro dele existem uma série de outras rotinas que são acionadas todos os dias quando rodo uma macro, então ao criar essa rotina de enviar e-mail queria colocar no final da utima macro que tenho no meu arquivo uma Call EnviarEmail, por exemplo.

Consegui chegar até aqui criando um código por conta própria:

Sub Email()

Dim EnviarPara As String
Dim Mensagem As String


Planilha2.Activate


EnviarPara = Range("A1").Value
If EnviarPara <> "" Then
Mensagem = Range("B2").Value
Enviar EnviarPara, Mensagem
End If

End Sub

Sub Enviar(EnviarPara As String, Mensagem As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim AnexPath As String
'atribui caminhos dos anexos
AnexPath = Range("C1")


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = EnviarPara 'destinatário
.CC = "" 'cópia
.BCC = "" 'cópia oculta
.Subject = "#FPAClosing - Prévia de Opex - 9+3 - Razão IESsunto do e-mail"
.Body = Range("B1")
If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath)
.Send ' para envia o email diretamente defina o código .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

Detalhe: essa rotina está pronta, massss, eu não consigo enviar para mais de 40 destinatários de uma só vez, que é o que eu preciso.

[mucascosta]

Tente assim:

Código: Selecionar todos

Sub Email()
Dim EnviarPara As String, Mensagem As String, Ul As String, i As Integer
    Plan1.Activate
With ActiveSheet
    Ul = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To Ul
    EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
If EnviarPara <> "" Then
    Mensagem = Range("B2").Value
    Enviar EnviarPara, Mensagem
End If
Next i
End Sub

[RodrigoP]

Bom Dia
eu utilizo esse código abaixo

Sub Enviar_Email()

ActiveWorkbook.Save

Dim MyOlapp As Object, MeuItem As Object
Set MyOlapp = CreateObject("Outlook.Application")
Set MeuItem = MyOlapp.CreateItem(olMailItem)
With MeuItem


.to = ("COLOCAR O EMAIL AQUI")
.Subject = "Resumo de Produção Diário por Linha - " & Worksheets("CV").Range("I4")


.Attachments.Add "Caminho dos arquivos"


.Display



End With
End Sub

[AndreAnjos]

Tente assim:

Código: Selecionar todos

Sub Email()
Dim EnviarPara As String, Mensagem As String, Ul As String, i As Integer
    Plan1.Activate
With ActiveSheet
    Ul = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To Ul
    EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
If EnviarPara <> "" Then
    Mensagem = Range("B2").Value
    Enviar EnviarPara, Mensagem
End If
Next i
End Sub

Não deu certo, eu tenho uma lista de 40 e-mails para enviar, nesse código que vc mandou ele me atrás apenas um e-mail, mesmo que eu tenha vários e-mails nas células abaixo, ou vários e-mails em uma célula só

[AndreAnjos]

Bom Dia
eu utilizo esse código abaixo

Sub Enviar_Email()

ActiveWorkbook.Save

Dim MyOlapp As Object, MeuItem As Object
Set MyOlapp = CreateObject("Outlook.Application")
Set MeuItem = MyOlapp.CreateItem(olMailItem)
With MeuItem


.to = ("COLOCAR O EMAIL AQUI")
.Subject = "Resumo de Produção Diário por Linha - " & Worksheets("CV").Range("I4")


.Attachments.Add "Caminho dos arquivos"


.Display



End With
End Sub

Assim não funciona, preciso de uma macro que consiga enviar um e-mail para mais de 40 destinatários de uma só vez.

[Raygsson]

Mandar pra mais de um destinatário é a parte mais fácil, coloque os e-mails na propriedade ".to" separando por ";"

Exemplo:

.To = "email1@gmail.com;email2@gmail.com"

[AndreAnjos]

Mandar pra mais de um destinatário é a parte mais fácil, coloque os e-mails na propriedade ".to" separando por ";"

Exemplo:

.To = "email1@gmail.com;email2@gmail.com"

Então mano, não sabia que dava pra fazer essa parada aí, valeu pela dica. Mas eu to fazendo um esquema pra outras pessoas usarem, que não manjam de VBA, de qualquer forma, consegui montar essa macro aqui, se liga:

Sub Magic()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim AnexPath As String

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

'Using the email, add multiple recipients, using a list of addresses in column A.
Planilha2.Activate
AnexPath = Range("C1")
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
If SDest = "" Then
SDest = Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Cells(iCounter, 1).Value
End If
Next iCounter

'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.

.to = SDest
.Subject = "#FPAClosing - Prévia de Opex - 9+3 - Razão UnP"
.Body = Range("B1")
If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath)
.send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub