Hi there Experts – call me Novice.

Firstly I have less than average knowledge of Access and VBA coding but that’s as far as it goes. Here is my problem. I have created a database that is used to manage and track functions within the organization. So as to optimize the sharing of information, it was requested that the database be able link into a Microsoft Outlook calendar so that other accounts could share the information.

The requirement is for a user to be able to both view and create new entries in the Outlook 2003 calendar of another user’s mailbox using the Access 2000 database. The ‘other’ mailbox is called Functions. The network uses Microsoft Exchange for mail delivery.

Utilizing code hints that I have found on other forums I have been able to create and view entries in my own Outlook calendar but not another user’s calendar – this is the key requirement. Permissions have been granted for my default account to have full permissions to the other e-mail account.

As stated earlier the problem is in two parts. Firstly, as the code has been ‘patched’ from different sources it is highly probable that some of the code is redundant or completely wrong – as I said earlier, I’m just a novice.

The first requirement is to be able to view the other mailbox calendar. This is run from a command button click. My current code is shown below.

Private Sub btnCalChck_Click()
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim strMsg As String
Dim strName As String
On Error Resume Next

strName = "Functions"

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
Set objFolder = objNS.GetSharedDefaultFolder(myRecip, olFolderCalendar)
CalendarFolder.Display
Else
MsgBox "Could not find " & Chr(34) & strName & Chr(34), , "User not found"

End If
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
End Sub


The second requirement is to be able to add new items to the other mailbox calendar. This is also run from a command button click. My current code is shown below.


Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err

'Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

If IsNull(Me!ApptNotes) Then
MsgBox "Basic details must be added to the Function Summary field before function can be added to Calendar"
Exit Sub
End If

'Exit the procedure if appointment has been added to Calendar.
If Me!AddedToOutlook = True Then
MsgBox "This function is already added to Functions Calendar"
Exit Sub
'Add a new appointment.
Else

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim strMsg As String

strName = "Functions"

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strName)
Set objFolder = objNS.GetSharedDefaultFolder(myRecip, olFolderCalendar)


With objAppt
.start = Me!ApptStartDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt


If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes


If Not IsNull(Me!ApptLocation) Then .Location = Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
Else
.ReminderSet = False
End If


.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
End If

'Release the Outlook object variable.
Set objApp = Nothing
Set objNS = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objFolder = Nothing

'Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Function Added!"

Exit Sub

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

This existing code doesn’t work. Any assistance would be greatly appreciated

I haven't worked a lot with Outlook but ... what error message is coming up?
Also - if you take the error handling off, what line is it stopping on?

I need to go on to my customers site to be able to test the code. I'll be away for a week but I'll come back to you as soon as I can