附加多个文件发送电子邮件或整个目录（VBA）

我试图通过VBA和outlook发送带有多个附件的电子邮件。

如果我指定一个附件/文件的path，我可以添加多个附件，如果我确切地知道它们是什么，但是我不会向前移动 – 将会有不同的计数以及文件名。

我很想发送使用通配符，如下面的示例中所示，但我想我需要使用某种types的循环指向一个目录。

我已经四处寻找解决scheme，但我还没有看到任何与我的具体情况一致的东西。

Private Sub Command22_Click() Dim mess_body As String Dim appOutLook As Outlook.Application Dim MailOutLook As Outlook.MailItem Set appOutLook = CreateObject("Outlook.Application") Set MailOutLook = appOutLook.CreateItem(olMailItem) Set appOutLook = CreateObject("Outlook.Application") Set MailOutLook = appOutLook.CreateItem(olMailItem) With MailOutLook .BodyFormat = olFormatRichText .To = "[e-mail]" .Subject = "test" .HTMLBody = "test" .Attachments.Add ("H:\test\Adj*.pdf") '.DeleteAfterSubmit = True .Send End With MsgBox "Reports have been sent", vbOKOnly End Sub 

Answer 1

这是你正在尝试？ （另）

 Private Sub Command22_Click() Dim mess_body As String, StrFile As String, StrPath As String Dim appOutLook As Outlook.Application Dim MailOutLook As Outlook.MailItem Set appOutLook = CreateObject("Outlook.Application") Set MailOutLook = appOutLook.CreateItem(olMailItem) '~~> Change path here StrPath = "H:\test\" With MailOutLook .BodyFormat = olFormatRichText .To = "[e-mail]" .Subject = "test" .HTMLBody = "test" '~~> *.* for all files StrFile = Dir(StrPath & "*.*") Do While Len(StrFile) > 0 .Attachments.Add StrPath & StrFile StrFile = Dir Loop '.DeleteAfterSubmit = True .Send End With MsgBox "Reports have been sent", vbOKOnly End Sub