How to make recurring task (Like OUTLOOK) in VBA?

Function GetRecTaskDates(dStart As Date, dEnd As Date, objTask As Object)


Dim objTempApnt As Object
Dim objTaskPatt As Object
Dim objTempPatt As Object
Dim objCurApnt As Object
Dim dCurDate As Date
Dim arrResult()
Dim iCount As Integer
Dim n As Integer
Dim lRecType As Long


Set objTempApnt = objTask.Application.CreateItem(olAppointmentItem)
objTempApnt.Subject = "temp"


Set objTempPatt = objTempApnt.GetRecurrencePattern
Set objTaskPatt = objTask.GetRecurrencePattern


With objTempPatt
.RecurrenceType = objTaskPatt.RecurrenceType
lRecType = .RecurrenceType
If objTaskPatt.DayOfMonth Then .DayOfMonth = objTaskPatt.DayOfMonth
If lRecType = 1 Or lRecType = 3 Or lRecType = 6 Then .DayOfWeekMask = objTaskPatt.DayOfWeekMask
.StartTime = #9:00:00 AM#
.EndTime = #10:00:00 AM#
.PatternStartDate = objTaskPatt.PatternStartDate
If objTaskPatt.Interval Then .Interval = objTaskPatt.Interval
If objTaskPatt.NoEndDate Then
.NoEndDate = objTaskPatt.NoEndDate
Else
.Occurrences = objTaskPatt.Occurrences
.PatternEndDate = objTaskPatt.PatternEndDate
End If
If lRecType >= 5 Then .MonthOfYear = objTaskPatt.MonthOfYear
If lRecType = 3 Or lRecType = 6 Then .Instance = objTaskPatt.Instance
End With


objTempApnt.Save


For dCurDate = dStart To dEnd
On Error Resume Next
Set objCurApnt = objTempPatt.GetOccurrence(dCurDate + objTempPatt.StartTime)
If Err.Number = 0 Then
n = n + 1
ReDim Preserve arrResult(1 To n)
arrResult(n) = dCurDate
End If
Err.Clear
Next dCurDate
On Error GoTo 0


objTempApnt.ClearRecurrencePattern
objTempApnt.Delete


If n > 0 Then GetRecTaskDates = arrResult


End Function