Vba 将个人电子邮件发送给文件夹中包含所有文件的预定义人员集

我在文件夹“C:\Email”中更新了一堆文件。这些是每周创建的PDF文件。这个数字可能介于50到500或更多文件之间。文件名是随机的

我需要将这些文件分别发送到三个地址a@a.com,b@b.com及c@c.com. 我无法一次性发送所有文件，它们需要单独发送。主题将是文件的名称，正文将保持不变-“请查找附件。谢谢并问候ABC”

我一直在使用几个excel工作表的组合，其中我使用命令行语法（即“C:\Program Files\Microsoft Office\Office12\Outlook.exe/C ipm.note/m”）计算批处理文件的文件名所需的所有参数a@a.com,b@b.com,c@c.com&主题=&body=请查找附件。谢谢和问候，ABC“

这是我今天想到的最简单的事情，但它很麻烦，因为它打开的outlook新邮件窗口和打开的文件一样多，这可能会让人厌烦。其次，这不允许我自动发送邮件

---

希望有人能想出一个VBS/Windows脚本/VBA代码来实现同样的自动化。

您可以尝试使用CDO.Message对象从VBScript发送电子邮件。下面是从

---

您可以将其放入循环结构中，以发送文件夹中的每个文件。使用Dir循环获取每个PDF文件并创建一封新电子邮件。类似如下：

Const SOURCE_FOLDER As String = "C:\Email\"
Const RECIP_A As String = "a@a.com"
Const RECIP_B As String = "b@b.com"
Const RECIP_C As String = "c@c.com"
Const EMAIL_BODY As String = "Please find attached file. Thanks and Regards, ABC"

Sub SendPDFs()

  On Error GoTo ErrorHandler

  Dim fileName As String

  fileName = Dir(SOURCE_FOLDER)

  Do While Len(fileName) > 0
    Call CreateEmail(SOURCE_FOLDER & fileName)

    Dir (SOURCE_FOLDER)
  Loop

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.number & " - " & Err.description
  Resume ProgramExit
End Sub

Function CreateEmail(fileName As String)

Dim olApp As Outlook.Application
Dim msg As Outlook.MailItem

  ' create email
  Set olApp = Outlook.Application
  Set msg = olApp.createitem(olMailItem)

  ' set properties
  With msg
    .Body = EMAIL_BODY
    .Recipients.Add (RECIP_A)
    .Recipients.Add (RECIP_B)
    .Recipients.Add (RECIP_C)
    .Attachments.Add fileName
    .Send
  End With

End Function

这会将电子邮件文件夹中的每个文件发送给每个收件人，但不会为每个PDF发送三封单独的电子邮件。如果您特别需要，可以更改代码。

替换代码

Do While Len(fileName) > 0     
Call CreateEmail(SOURCE_FOLDER & fileName)      
Dir (SOURCE_FOLDER)   
Loop  

与

---

非常感谢JP。该代码似乎工作正常，但只接受循环目录中文件列表中的第一个文件。因此，该程序进入了一个无休止的循环，试图重复发送第一个文件。我编写了代码，但没有测试它。看起来你在下面修复了它！

Do While Len(fileName) > 0     
Call CreateEmail(SOURCE_FOLDER & fileName)      
Dir (SOURCE_FOLDER)   
Loop  

Do While Len(fileName) > 0     
Call CreateEmail(SOURCE_FOLDER & fileName)      
filename = Dir   
Loop