'*********************************************************************
' VARIABLE DEFINITION
'*********************************************************************
const UNKNOWN = "Chickenless Soup"
dim arrAttachments()
dim strAttachmentsFolder
dim strFrom
dim strSubject
dim strMessage
set objFSO = CreateObject("Scripting.FileSystemObject")
set dicAttachments = CreateObject("Scripting.Dictionary")
strAttachmentsFolder = "C:\Temp"
strFrom = "me@domain.com"
strSubject = "Daily Attachments"
strMessage = "Here are your daily attachments"
'*********************************************************************
' FUNCTIONS
'*********************************************************************
'determin yesterday
function getYesterday()
'get the numeric representation of yesterdays month
intMonth = month(date - 1)
'set the string appreviation of the numeric month
select case (intMonth)
case 1 : strMonth = "Jan"
case 2 : strMonth = "Feb"
case 3 : strMonth = "Mar"
case 4 : strMonth = "Apr"
case 5 : strMonth = "May"
case 6 : strMonth = "Jun"
case 7 : strMonth = "Jul"
case 8 : strMonth = "Aug"
case 9 : strMonth = "Sept"
case 10 : strMonth = "Oct"
case 11 : strMonth = "Nov"
case 12 : strMonth = "Dec"
end select
'return strMonth_yesterday (eg Nov_2)
getYesterdaay = strMonth & "_" & day(date - 1)
end function
'determine if strFileName is from yesterday
function isFileValid(strFileName)
'set the default validity to false
isFileValid = false
'Assuming the files have the nomeclature of Client_month_day_var.pdf
'split strFileName into pieces by "_"
arrPieces = split(strFileName, "_")
'if there 4 peices (0-3) then continue validating
if (ubound(arrPieces) = 3) then
strMonth = arrPieces(1)
strDay = arrPieces(2)
'set strYesterday to whatever the function getYesterday() returns.
strYesterday = getYesterday()
if (strYesterday = strMonth & "_" & strDay) then
'check to see if the file has a pdf extention. If so, set isFileValid to true
if (right(strFileName, 4) = ".pdf") then isFileValid = true
end if
end if
end function
'*********************************************************************
' main
'*********************************************************************
'get a collection of file in the strAttachmentsFolder
set colFiles = objFSO.GetFolder(strAttachmentsFolder).Files
'run through each file in the collection
for each objFile in colFiles
'check to see if the current file is a valid attachment
if (isFileValid(objFile.Name) = true) then
'get the client name from the file name
strClient = left(objFile.Name, instr(objFile.Name, "_"))
'depending on the value of strClient, set strTo (a recipient)
select case lcase(strClient)
case "bob" : strTo = "bob@organics.com"
case "joe" : strTo = "boss@capital.com"
case "janet" : strTo = "janet@office.gov"
case else : strTo = UNKNOWN
end select
if (strTo <> UNKNOWN) then
'add client (new dictionary key) if they aren't already in the dictionary of attachments
if NOT (dicAttachments.Exists(strClient)) then
dicAttachments.Add strClient, array(strTo)
end if
'get the array of attachments
arrAttachments = dicAttachments.Item(strClient)
'because we are adding a new attachment to the array, we need to make sure there is room for it.
intIndex = ubound(arrAttachments) + 1
'redimension arrAttachment to the new size while preserving its contents
redim preserve arrAttachment(intIndex)
'add the attachment file to the new index
arrAttachment(intIndex) = objFile.Path
'put the array back in the dictionary or attachments for the client.
dicAttachments.Item strClient, arrAttachments
end if
end if
next
'get all the clients (keys) of the attachments dictionary and store them in an array
arrClients = dicAttachments.Keys
'run through the arrClients array
for i = 0 to ubound(arrClients)
'set strClient to the index (i) of arrClients
strClient = arrClients(i)
'get the array if attachment for this client
arrAttachments = dicAttachments.Item(strClient)
'create an email object
set objEmail = CreateObect("cdo.message")
'set certain email properties
objEmail.To = arrAttachments(0)
objEmail.From = strFrom
objEmail.Subject = strSubject
objEmail.Message = strMessage
objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "nmhexevs01.nmh.nmrhs.net"
objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
objEmail.Configuration.Fields.Update
'add each file in arrAttachments to the email
for j = 1 to ubound(arrAttachments)
objEmail.AddAttachment(arrAttachments(j))
next
'send email
objEmail.Send
next
msgbox "done"