Send individual emails to predefined set of people with all files in a folder

I have a bunch of files that get updated in the folder "C:\Email". These are PDF files that are created on a weekly basis. This could number from anywhere between 开发者_如何学编程50 to 500 or more files. The file names are random.

I need to send out these files individually to three addresses say a@a.com,b@b.com and c@c.com. I cannot send all the files in one go, they need to go individually. The subject will be the name of the file and the body will remain the same - "Please find attached file. Thanks and Regards, ABC".

I have been using a combination of a few excel sheets where i concatanate all the required parameters to to come up with the file names for a batch file using the command line syntax i.e. "C:\Program Files\Microsoft Office\Office12\Outlook.exe /c ipm.note /m "a@a.com,b@b.com,c@c.com&subject=<>&body=Please find attached file. Thanks and Regards, ABC"

this is the simplest thing I have come up with today but it is cumbersome as it opens up as many outlook new message windows as there are files, which can get tiresome. Secondly this does not let me send the message automatically.

Hope some one can come up with a VBS / Windows script / VBA code to automate the same.

Use a Dir Loop to grab each PDF file and create a new email. Something like this:

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

This will send each file in the Email folder to each recipient, but it doesn't send three separate emails for each PDF. If you need that specifically, the code can be changed.

You can try sending email from VBScript using a CDO.Message object. Here is an example taken from http://www.paulsadowski.com/wsh/cdo.htm

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

You would place this into a loop structure to send each file in the folder

Replace the code

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

with

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