Enviar anexos de E-mail do excel via VBA

Question

Enviar anexos de E-mail do excel via VBA

Escrevi uma macro que, ao clicar num botão, envia um e-mail automatizado através do outlook. Tudo corre bem, só que eu não consigo descobrir como anexar um arquivo ao E-mail. Em todos os lugares que eu procurei, o código de exemplo para anexar arquivos a um e-mail é para arquivos com nomes estáticos, como em, você está enviando o mesmo nome de arquivo, com o mesmo caminho todas as vezes.

Se isso o torna mais conveniente, o botão que executa esta macro está dentro do manual que estou a tentar anexar. Eu ... Não tenho certeza se abrir uma janela do Windows explorer é mais fácil e anexar o arquivo dessa forma seria melhor.

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.recipient
Dim objOutlookAttach As Outlook.Attachment
Dim WeekendingDate As Date

With Worksheets("Macro Buttons")
    WeekendingDate = Range("N2").Value
End With

Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
    Set objOutlookRecip = .Recipients.Add("blah@blah")
    objOutlookRecip.Type = olTo
   .Subject = "Blah " & WeekendingDate
   .Body = "blah blah blah"

' adicionar anexos à mensagem [algum código]

   For Each objOutlookRecip In .Recipients
       objOutlookRecip.Resolve
   Next
   If DisplayMsg Then
       .Display
   Else
       .Save
   End If
End With
Set objOutlook = Nothing
End Sub

4

excel vba excel-vba outlook email-attachments

Author: Community, 2016-05-18

Source

1 answers

score 7 · Accepted Answer

É necessário inserir o código Attachments.Add na configuração do MailItem:

With objOutlookMsg
    Set objOutlookRecip = .Recipients.Add("blah@blah")
    objOutlookRecip.Type = olTo
   .Subject = "Blah " & WeekendingDate
   .Body = "blah blah blah"
'Add attachments to the message [some code]
   .Attachments.Add "pathToFile"
   For Each objOutlookRecip In .Recipients
       objOutlookRecip.Resolve
   Next
   If DisplayMsg Then
       .Display
   Else
       .Save
   End If
End With
Set objOutlook = Nothing

Num dos meus próprios scripts, passo uma colecção de anexos ao MailItem para ser anexado usando um objecto de dicionário e o seguinte código:

With oMailItem
        Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
        .To = EmailData("To")
        .CC = EmailData("CC")
        .BCC = EmailData("BCC")
        .Subject = EmailData("Subject")
        .Body = EmailData("Body")
        sAttachArray = Split(EmailData("AttachmentPaths"), ";")
        For Each sAttachment In sAttachArray
            .Attachments.Add(sAttachment)
        Next
        .Recipients.ResolveAll
        .Display    ' debug mode - uncomment this to see email before it's sent out
    End With