使用Outlook VBA将多个附件添加到单个电子邮件中

编辑

Sub CreateEmail(Subject As String, Body As String, ToSend As String, CCs As String, FilePathtoAdd As String)

 Dim OlApp As Object
 Dim OlMail As MailItem
 Dim ToRecipient As Variant
 Dim CcRecipient As Variant
 Dim Attachments() As String
 Dim i As Integer

 Set OlApp = Application
 Set OlMail = OlApp.CreateItem(olMailItem)

 OlMail.Recipients.Add ToSend

 OlMail.Subject = Subject
 OlMail.Body = Body
 OlMail.SentOnBehalfOfName = "mailbox"

 If FilePath1 <> "" Then

If FilePathtoAdd <> "" Then
    Attachments = Split(FilePathtoAdd, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            OMail.Attachments.Add Trim(Attachments(i))
        End If
    Next i
End If

End If

 OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

 End Sub
Sub EmailIt()
CreateEmail "This is Subject", "Body", "To", "CC", "C:\Users\b\Desktop\NFM\Export\0418 LSN " & Format(Date, "mm-dd-yy") & ".xls", "C:\Users\b\Desktop\NFM\Export\0418 Backorder " & Format(Date, "mm-dd-yy") & ".xls"

End Sub

我正在Outlook vba中使用以下代码创建电子邮件，附加文件并发送电子邮件.它工作正常，除了我不知道如何在单个电子邮件中添加多个附件?任何帮助将不胜感激.

Sub CreateEmail(Subject As String, Body As String, ToSend As String, CCs As String, FilePathtoAdd As String)

 'write the default Outlook contact name list to the active worksheet

 Dim OlApp As Object
 Dim OlMail As MailItem
 Dim ToRecipient As Variant
 Dim CcRecipient As Variant

'Set OlApp = CreateObject("Outlook.Application")
 'Set OlMail = OlApp.CreateItem(olMailItem)

 Set OlApp = Application
 Set OlMail = OlApp.CreateItem(olMailItem)

 'For Each ToRecipient In Array("[e-mail]", "[e-mail]", "[e-mail]")
 'OlMail.Recipients.Add ToRecipient
 OlMail.Recipients.Add ToSend
 'Next ToRecipient

'fill in Subject field
 OlMail.Subject = Subject
 OlMail.Body = Body
 OlMail.SentOnBehalfOfName = "email.com"

 'Add the active workbook as an attachment
' OlMail.Attachments.Add "C:\Users\Ali\Desktop\Sentence Correction\Comparisons.pdf"
 If FilePathtoAdd <> "" Then
    OlMail.Attachments.Add FilePathtoAdd
End If
 'Display the message
 OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

 End Sub
Sub EmailIt()
CreateEmail "This is Subject", "Body", "email.com", " ", "C:\Users\b\Desktop\NFM\Export\0418 LSN " & Format(Date, "mm-dd-yy") & ".xls"

End Sub

解决方案

您只需要这样做:

Olmail.attachments.add secondpath

如果将附件路径放在逗号分隔的字符串中，并将其作为"FilePathToAdd"传递，则可以执行以下操作:

Dim Attachments() As String
Dim i As Integer

If FilePathToAdd <> "" Then
    Attachments = Split(FilePathToAdd, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            OlMail.Attachments.Add Trim(Attachments(i))
        End If
    Next i
End If

• 原文

EDIT

Sub CreateEmail(Subject As String, Body As String, ToSend As String, CCs As String, FilePathtoAdd As String)

 Dim OlApp As Object
 Dim OlMail As MailItem
 Dim ToRecipient As Variant
 Dim CcRecipient As Variant
 Dim Attachments() As String
 Dim i As Integer

 Set OlApp = Application
 Set OlMail = OlApp.CreateItem(olMailItem)

 OlMail.Recipients.Add ToSend

 OlMail.Subject = Subject
 OlMail.Body = Body
 OlMail.SentOnBehalfOfName = "mailbox"

 If FilePath1 <> "" Then

If FilePathtoAdd <> "" Then
    Attachments = Split(FilePathtoAdd, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            OMail.Attachments.Add Trim(Attachments(i))
        End If
    Next i
End If

End If

 OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

 End Sub
Sub EmailIt()
CreateEmail "This is Subject", "Body", "To", "CC", "C:\Users\b\Desktop\NFM\Export\0418 LSN " & Format(Date, "mm-dd-yy") & ".xls", "C:\Users\b\Desktop\NFM\Export\0418 Backorder " & Format(Date, "mm-dd-yy") & ".xls"

End Sub

I'm using the code below, in outlook vba, to create an email, attach a file, and send the email. It works fine, except I can't figure out how to add multiple attachments to a single email? Any help is greatly appreciated.

Sub CreateEmail(Subject As String, Body As String, ToSend As String, CCs As String, FilePathtoAdd As String)

 'write the default Outlook contact name list to the active worksheet

 Dim OlApp As Object
 Dim OlMail As MailItem
 Dim ToRecipient As Variant
 Dim CcRecipient As Variant

'Set OlApp = CreateObject("Outlook.Application")
 'Set OlMail = OlApp.CreateItem(olMailItem)

 Set OlApp = Application
 Set OlMail = OlApp.CreateItem(olMailItem)

 'For Each ToRecipient In Array("[e-mail]", "[e-mail]", "[e-mail]")
 'OlMail.Recipients.Add ToRecipient
 OlMail.Recipients.Add ToSend
 'Next ToRecipient

'fill in Subject field
 OlMail.Subject = Subject
 OlMail.Body = Body
 OlMail.SentOnBehalfOfName = "email.com"

 'Add the active workbook as an attachment
' OlMail.Attachments.Add "C:\Users\Ali\Desktop\Sentence Correction\Comparisons.pdf"
 If FilePathtoAdd <> "" Then
    OlMail.Attachments.Add FilePathtoAdd
End If
 'Display the message
 OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

 End Sub
Sub EmailIt()
CreateEmail "This is Subject", "Body", "email.com", " ", "C:\Users\b\Desktop\NFM\Export\0418 LSN " & Format(Date, "mm-dd-yy") & ".xls"

End Sub

解决方案

You just need to do:

Olmail.attachments.add secondpath

If you put the attachment paths in a comma delimited string and pass it as "FilePathToAdd" then you can do this:

Dim Attachments() As String
Dim i As Integer

If FilePathToAdd <> "" Then
    Attachments = Split(FilePathToAdd, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            OlMail.Attachments.Add Trim(Attachments(i))
        End If
    Next i
End If