creating an outlook calendar date from an excel column

Hi everybody!!
I need help. I would like to create a macro to run in excel and make an outlook appointment automatically.
This is for make an appointment to remember when will expire some project in this column.
Somebody can help me, because I'm really new with this of VBA...

Thanks in advance for any help

Create an appointment in MS Outlook Default Calendar


Suprisingly this stayed unanswered !

The procedure below creates appointment, picking subject in range A2:A... and picking start time from next column.

Sub MS_OL_Appointment_Creation()
Dim objOutlook As Object 'As Outlook.Application
Dim olAppt As Object 'Outlook.AppointmentItem
Dim NS 'As Outlook.Namespace
Dim colItems 'As Outlook.Items
Dim olApptSearch 'As Outlook.AppointmentItem
Dim r As Long, sSubject As String, sBody As String
Dim dStartTime As Date, dDuration As Double
Dim sSearch As String, bOLOpen As Boolean

Dim cl As Range

Dim olApp As Object
Dim olNs As Object
Const olFldrCalendar As Long = 9
Dim olApt As Object
Dim bAllDayEvent As Boolean
Dim bReminderSet As Boolean
bAllDayEvent = True
bReminderSet = False
dDuration = 30

'' Get the MS Outlook opened instance or open one.
'On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
bOLOpen = True
If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
bOLOpen = False
End If

'' Get Namespace
Set NS = objOutlook.GetNamespace("MAPI")

'' Get default calendar items
Set colItems = NS.GetDefaultFolder(olFolderCalendar).Items

For Each cl In Range("A2", Range("A" & Cells.Rows.Count).End(xlUp))
dStartTime = cl.Offset(, 1) & " 00:00"
sSubject = cl.Text
sBody = "this is the appointment description : " & cl.Offset(, 2)

'' Search for already existing appointments comparing subject and date fields.
sSearch = "[Subject] = " & sQuote(sSubject) '& " and [Start] = " & sQuote(dSartTime)
Set olApptSearch = colItems.Find(sSearch)

If olApptSearch Is Nothing Then
Set olAppt = objOutlook.CreateItem(olAppointmentItem)
olAppt.Subject = sSubject
olAppt.Body = sBody
olAppt.Start = dStartTime
olAppt.AllDayEvent = bAllDayEvent
olAppt.ReminderSet = true
'olAppt.Duration = dDuration
olAppt.Save 'Close olSave
End If

Debug.Print cl.Address
Next cl

If bOLOpen = False Then objOutlook.Quit

End Sub
Function sQuote(TheText) As String
sQuote = "'" & TheText & "'"
End Function

I am trying to use the above

I am trying to use the above VB code for creating Outlook Calendar appointments, however I can't seem to set some options that I require. I can get it to create the appointments, however I cannot get it to set a time. It will only work if I put 00:00 in for the time and that creates a Full-Day event.

Also, I cannot figure out how to set the duration of the event or the reminder.

Can anyone advise how I can set these options?


Here is what I have in my sheet:

Subject Start Body Duration Reminder
Subject Text 16th Jan 16/01/2014 00:00 Body Text 60 1440


Many thanks in advance...