将单独的电子邮件发送给预先定义的一组文件夹中所有文件的人

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

Set objMessage = CreateObject(\"CDO.Message\") 
objMessage.Subject = \"Example CDO Message\" 
objMessage.From = \"me@my.com\" 
objMessage.To = \"test@paulsadowski.com\" 
objMessage.TextBody = \"This is some sample message text.\" 
objMessage.AddAttachment \"c:\\temp\\readme.txt\"
objMessage.Send

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