Outlook VBA for sending emails with attachment

Question

I need to send almost 100 emails in one day to different people with different filenames. The code below works perfectly fine but the problem is that the files I have to attach should be dated one day previous. For example the date today is 7th march 2013 (7-03-13). I get the files RN2425 06-03-13.xls and these change every day. I want to lookup the one day previous files in particular directory D:\Reporting\Daily\RN2425\RN2425 (one day previous datestamp).xls

Please help me by using this code I need to change the dates in the filenames. I want this to be done automatically.

Sub CreateEmail(Subject As String, Body As String, ToSend As String, CCs As String, FilePathtoAdd As String)

 'write the default Outlook contact name list to the active worksheet

 Dim OlApp As Object
 Dim OlMail As MailItem
 Dim ToRecipient As Variant
 Dim CcRecipient As Variant


 'Set OlApp = CreateObject("Outlook.Application")
 'Set OlMail = OlApp.CreateItem(olMailItem)

 Set OlApp = Application
 Set OlMail = OlApp.CreateItem(olMailItem)

 'For Each ToRecipient In Array("[email protected]", "[email protected]", "[email protected]")
 'OlMail.Recipients.Add ToRecipient
 OlMail.Recipients.Add ToSend
 'Next ToRecipient



 'For Each CcRecipient In Array("[email protected]", "[email protected]", "[email protected]")
 'With OlMail.Recipients.Add(CcRecipient)
 '.Type = 2
 'End With
 'Next CcRecipient
 Dim Temp As Recipient
 Set Temp = OlMail.Recipients.Add(CCs)
 Temp.Type = olCC


 'fill in Subject field
 OlMail.Subject = Subject
 OlMail.Body = Body

 'Add the active workbook as an attachment
' OlMail.Attachments.Add "C:\Users\Ali\Desktop\Sentence Correction\Comparisons.pdf"
 If FilePathtoAdd <> "" Then
    OlMail.Attachments.Add FilePathtoAdd
 End If
 'Display the message
 OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

 End Sub
Sub EmailIt()
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\RN2425 06-03-13.xls"
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\RN2425 06-03-13.xls"
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\RN2425 06-03-13.xls"
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\RN2425 06-03-13.xls"
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\RN2425 06-03-13.xls"
CreateEmail "This is Subject", "Body", "[email protected], [email protected]", "[email protected], [email protected]", "E:\Ali's Documents\AVSEQ03 Comp 1.avi"

End Sub

Solution

To get today's date in the correct format:

• Format(Date,"dd-mm-yy")

To get yesterdays date:

• DateAdd("d", -1, Date)

Putting it all together:

• "E:\Ali's Documents\RN2425 " & Format(DateAdd("d", -1, Date),"dd-mm-yy") & ".xls"