Hello Sue,
I have been trying for days to make this work and so far no luck. What I
would like to do is be able to schedule someone elses' appointments in
Outlook via MS Access. I posed this question in the Access discussion group
and I was told to try this group.
What I've been able to do successfully is to schedule my own appointment,
but scheduling someone's appointment has been difficult. I'm not good at VB
and I've used the same codes in this thread, but when I click on the command
button on my form, nothing happens. No error message, no appointments were
updated in Outlook, nothing. Can you please help me? I have to have this
completed by tomorrow for a presentation on Monday and I have no idea on how
to resolve this.
Please help.
Here are the codes that I've entered in the module:
---
Option Compare Database
Option Explicit ' Force explicit variable declaration.
Dim MyVar ' Declare variable.
MyInt = 10 ' Undeclared variable generates error.
MyVar = 10 ' Declared variable does not generate error.
Private Sub cmdAddAppt_Click()
On Error GoTo Err_cmdAddAppt_Click
' Save record first to be sure required fields are filled.
DoCmd.GoToRecord , , acNewRec
' Exit the procedure if appointment has been added to Outlook.
If AddedToOutlook = True Then
MsgBox "This appoiment is already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim objRecurPattern As Outlook.RecurrencePattern
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim strMsg As String
Dim strName As String
On Error Resume Next
'# # Change str to equal calendar you want to access# #
strName = "
[email protected]"
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
Set objNS = objOutlook.GetNamespace("MAPI")
Set objDummy = objOutlook.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = _
objNS.GetSharedDefaultFolder(objRecip, _
olFolderCalendar)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
'.Subject = "Test Appointment"
.Start = Me.ApptDate & "" & ApptTime
.Duration = ApptLength
.Subject = Appt
.Save
.Close (olSave)
If Not IsNull(ApptNotes) Then .Body = ApptNotes
If Not IsNull(ApptLocation) Then .Location =
ApptLocation
If ApptReminder Then
.ReminderMinutesBeforeStart = ReminderMinutes
.ReminderSet = True
End If
End With
End If
End If
Else
MsgBox "Could Not Find" & Chr(34) & strName & Chr(34), , _
"User Not Found"
End If
End If
'Release the Appoint object variable.
Set objOutlook = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
'Set the AddedToOutlook flag, save the record, display a message.
AddedToOutlook = True
DoComd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit_cmdAddAppt_Click:
Exit Sub
Err_cmdAddAppt_Click:
MsgBox Err.Description
Resume Exit_cmdAddAppt_Click
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
--------
Thanks,
Nyla
