Outlook .StartDate & .EndDate Sometimes Work

[nick34]

The goal is to email my Calendar every day, along with the previous days for that week. For example, on Thursday - send Monday through Thursday. It usually works fine, but some days it sends the current date and way too many previous days. Attached is the program (I am not claiming credit for this, a lot was copied from others work). Could someone please help me figure out why this works some days and doesn't other days? Here is the program:

Public Sub SendCalendar()

Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oCalendarSharing As CalendarSharing
Dim objMail As MailItem
Dim dtToday As Date
Dim dtOneDayAgo As Date
Dim dtTwoDaysAgo As Date
Dim dtThreeDaysAgo As Date
Dim dtFourDaysAgo As Date
Dim iWeekday As Integer

Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
Set oCalendarSharing = oFolder.GetCalendarExporter

dtToday = Date
dtOneDayAgo = DateAdd("d", -1, Date)
dtTwoDaysAgo = DateAdd("d", -2, Date)
dtThreeDaysAgo = DateAdd("d", -3, Date)
dtFourDaysAgo = DateAdd("d", -4, Date)

iWeekday = Weekday(Date)

If iWeekday = 2 Then
lDays = dtToday
ElseIf iWeekday = 3 Then
lDays = dtToday And dtOneDayAgo
ElseIf iWeekday = 4 Then
lDays = dtToday And dtTwoDaysAgo
ElseIf iWeekday = 5 Then
lDays = dtToday And dtThreeDaysAgo
ElseIf iWeekday = 6 Then
lDays = dtToday And dtFourDaysAgo
End If

With oCalendarSharing
.CalendarDetail = olFreeBusyAndSubject
.IncludeWholeCalendar = False
.IncludeAttachments = False
.IncludePrivateDetails = True
.RestrictToWorkingHours = False
.StartDate = dtFourDaysAgo
.EndDate = dtToday
End With

Set objMail = oCalendarSharing.ForwardAsICal(olCalendarMailFormatDailySchedule)

With objMail
'.Display
SendKeys "{TAB}" & "{TAB}" & "{TAB}" & "{DEL}" & "{DEL}"
.Recipients.Add "staff@xyzcompany.com"
.Subject = "EODR " & Format(Date, "mm-dd-yyyy")
.Attachments.Remove (1)
.Send
End With

Set oCalendarSharing = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing

End Sub