Hi All,

I am using the following code to add an appointment to Outlook from Excel:

Sub AddAppointmentsToCalendar()
Dim OLF As Outlook.MAPIFolder, objItem As Outlook.AppointmentItem
Dim i As Long, lngItemCount As Long, r As Long
On Error Resume Next
Set OLF = GetObject("",
"Outlook.Application").GetNamespace("MAPI").GetDef aultFolder(olFolderCalendar)
On Error GoTo 0
If OLF Is Nothing Then Exit Sub ' Outlook not available

Application.StatusBar = "Adding appointments to Outlook..."
With wsSheet1 ' the worksheet with the new appointments
.Activate
r = Range("NewAppointments").Row + 1 ' the first row with data
Do While Len(Range("A" & r).Formula) 0
On Error Resume Next
Set objItem = OLF.Items.Add(olAppointmentItem)
On Error GoTo 0
If Not objItem Is Nothing Then ' a new item is created
With objItem
.Start = Range("A" & r).Value
.End = Range("C" & r).Value
.Subject = Range("E" & r).Value
.Body = Range("F" & r).Value
.Categories = Range("G" & r).Value
.ReminderSet = True ' reminder
.Save ' the new item
End With
Set objItem = Nothing
End If
r = r + 1
Loop
End With
Application.StatusBar = False
End Sub

However, I would like to amend the code so that the start date for the
appointment is entered by the user in any
cell in column A starting in A7, the start time is entered in any cell in
column B starting in B7, the end date is entered
in any cell in column C starting at C7 and the end time is entered in any
cell in column D starting in D7.

Any ideas?

Thanks,

Steve