Excel vba enviar mais de um anexo no email

[rbbahia]

bom dia pessoal

Estou utilizando o código abaixo que cria um e-mail e envia um arquivo anexo cujo nome e caminho estão na variável VarFile esse código funciona, o problema é que eu preciso enviar dois arquivos.

Já tentei colocar os caminhos separados por vírgula e ponto-e-vírgula também mas ao fazer isso ele não acha os arquivos.

MailFromMacWithMail bodycontent:=ThisWorkbook.Sheets("Mailing list").Range("d" & i).Value, _

mailsubject:=ThisWorkbook.Sheets("Mailing list").Range("c" & i).Value, _

toaddress:=ThisWorkbook.Sheets("Mailing list").Range("b" & i).Value, _

ccaddress:="", _

bccaddress:="", _

attachment:=VarFile, _

displaymail:=False

espero que algum dos colegas possam ajudar.

Att.

Roberto

[dvbqp]

tenta usar esse codigo

Sub Enviar_email()

Dim enderecos As Range

Dim celula As Range

Dim anexo As String

Dim r As Integer

Dim fim

Dim enviar

Dim objOlAppApp As Outlook.Application

Dim objOlAppMsg As Outlook.MailItem

Dim objOlAppRecip As Outlook.Recipient

Dim objOlAppAnexo As Outlook.Attachment

Set objOlAppApp = CreateObject("Outlook.Application")

Set objOlAppMsg = objOlAppApp.CreateItem(olMailItem)

'Celulas com os endereços

Set enderecos = Sheets("Lista_e-mail").Range("d2:d300")

With objOlAppMsg

'Processar endereços para o envio

For Each celula In enderecos

If celula.Text <> "" And InStr(1, celula.Text, "@") > 0 Then

Set objOlAppRecip = .Recipients.Add(celula.Text)

'definir o tipo do destinatario

Select Case UCase(celula.Offset(0, 1).Text)

Case "CC"

objOlAppRecip.Type = olCC

Case "BCC"

objOlAppRecip.Type = olBCC

Case ""

objOlAppRecip.Type = olTo

End Select

End If

Next celula

'verificar se existe destinatário

If .Recipients.Count = 0 Then GoTo fim

'Anexar ficheiro, com o nome e caminho escrito na celula C13

anexo = Sheets("E-mail").Range("C33")

'verificar se o caminho para o anexo é válido

If Dir(anexo) = "" Then

r = MsgBox("Anexo inexistente ou caminho invalido, " & _

"pretende enviar assim mesmo ? ", _

vbYesNo, _

"Erro de anexo")

If r = vbYes Then GoTo enviar Else GoTo fim

End If

Set objOlAppAnexo = .Attachments.Add(anexo)

enviar:

'definir a sua importancia

.Importance = olImportanceHigh

'O assunto

.Subject = Sheets("E-mail").Range("C9")

'O conteudo do Mail

.Body = Sheets("E-mail").Range("C13")

'enviar mensagem

.Send

End With

fim:

'Libertar as variaveis

Set objOlAppApp = Nothing

Set objOlAppMsg = Nothing

Set objOlAppAnexo = Nothing

Set objOlAppRecip = Nothing

MsgBox "E-mail enviado com sucesso!", vbInformation

End Sub

[Leandro Salvadori]

@Eloize Teixeira Boa Tarde Elo, talvez esse tópico possa lhe ajudar. 

 

Cumprs