Hi
I am trying to populate the Outlook calendar with future appointments from Excel 2003 using VBA. Excel contains the dates I need. However, at the line marked **, I get the error below. Please could someone help.
I am trying to populate the Outlook calendar with future appointments from Excel 2003 using VBA. Excel contains the dates I need. However, at the line marked **, I get the error below. Please could someone help.
Sub SetAppt()
Dim olApp As Object
' Dim olApp As Outlook.Application
Dim olApt As Object
Dim olNs As Object
Dim usedate As Date
' The following routine displays the calendar, opening OL if needed
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If err.Number = 429 Then
Set olApp = CreateObject("Outlook.application")
End If
On Error Goto 0
Set olNs = olApp.GetNamespace("MAPI")
If olApp.ActiveExplorer Is Nothing Then
olApp.Explorers.Add _
(olNs.GetDefaultFolder(9), 0).Activate
Else
Set olApp.ActiveExplorer.CurrentFolder = _
olNs.GetDefaultFolder(9)
olApp.ActiveExplorer.Display
End If
' Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)
' Gather the values to use in the appointment
For Each cell In Range([a2], [a65536].End(xlUp))
usedate = [a2].Value
With olApt
.Start = usedate + TimeValue("9:00:00")** ' Object doesn't support this property or method (Error 438)
.End = usedate + TimeValue("11:00:00")
.Subject = usesubject
.Location = usesubject & " location"
.Body = "enter the text of your appointment here"
.BusyStatus = olOutOfOffice
.ReminderMinutesBeforeStart = 30
.ReminderSet = True
.Save
End With
olApt.Display
Next
Set olApt = Nothing
Set olApp = Nothing
Set olNs = Nothing
End Sub
Dim olApp As Object
' Dim olApp As Outlook.Application
Dim olApt As Object
Dim olNs As Object
Dim usedate As Date
' The following routine displays the calendar, opening OL if needed
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If err.Number = 429 Then
Set olApp = CreateObject("Outlook.application")
End If
On Error Goto 0
Set olNs = olApp.GetNamespace("MAPI")
If olApp.ActiveExplorer Is Nothing Then
olApp.Explorers.Add _
(olNs.GetDefaultFolder(9), 0).Activate
Else
Set olApp.ActiveExplorer.CurrentFolder = _
olNs.GetDefaultFolder(9)
olApp.ActiveExplorer.Display
End If
' Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)
' Gather the values to use in the appointment
For Each cell In Range([a2], [a65536].End(xlUp))
usedate = [a2].Value
With olApt
.Start = usedate + TimeValue("9:00:00")** ' Object doesn't support this property or method (Error 438)
.End = usedate + TimeValue("11:00:00")
.Subject = usesubject
.Location = usesubject & " location"
.Body = "enter the text of your appointment here"
.BusyStatus = olOutOfOffice
.ReminderMinutesBeforeStart = 30
.ReminderSet = True
.Save
End With
olApt.Display
Next
Set olApt = Nothing
Set olApp = Nothing
Set olNs = Nothing
End Sub