Sub ToCalendar()
'Add reference to MS Outlook Lbrary
Dim oOL As Outlook.Application, oAppoint As Outlook.AppointmentItem
Dim oWS As Worksheet, r As Long, i As Long, sStart, sHeleDag As String
Set oWS = Blad1
r = oWS.Range("A1").CurrentRegion.Rows.Count
Set oOL = New Outlook.Application
For i = 2 To r
Set oAppoint = oOL.CreateItem(olAppointmentItem)
With oAppoint
sStart = oWS.Cells(i, 3)
sStart = Left(sStart, Len(sStart) - 4) & Year(Date)
.Start = oWS.Cells(i, 3) + oWS.Cells(i, 5)
.End = oWS.Cells(i, 3) + oWS.Cells(i, 6)
' .Duration = oWS.Cells(i, 12)
.Subject = "Birth Date" & " " & oWS.Cells(i, 2) & " " & oWS.Cells(i, 1)
.Location = oWS.Cells(i, 10)
.Body = oWS.Cells(i, 11)
.MeetingStatus = olNonMeeting
If oWS.Cells(i, 13) = "j" Then
.AllDayEvent = True
Else
.AllDayEvent = False
End If
.ReminderSet = True
.ReminderMinutesBeforeStart = oWS.Cells(i, 7)
.Save
End With
Next i
MsgBox "Reminder(s) Added To Outlook Calendar"
Set oOL = Nothing
End Sub