Codetwo Public Folders structure for vba

[Melinda]

Hi, I have recently installed Codetwo Public Folders on my client's computers so they can shared one calendar including the category colours. It works great.
I have created an Access database to enter appointments into the calendar using the following line of code:

Set olfolder = olapp.GetNamespace("mapi").PickFolder

But I would like the appointments to post to the calendar without the user having to choose the calendar each time.
This code works fine on the host of the shared calendar but not on the other computers.

Set olfolder = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders("Deliveries")

My issue is that I can't figure out how to make this happen. I have searched all over the internet but I haven't been able to find something that works, or that I can understand and adapt. (I am a self taught code writer...so not very good)
Support at Codetwo weren't able to shed any light either.
The Pickfolder window shows the following structure:
C2PublicFolders - Other User's Folders - HUNTLYJOINERY\Tony - Calendar - Deliveries

this is the full code that I am using in my database:

Private Sub cmdAddCalendars_Click()
     Me.Dirty = False
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
Dim cat As Control
Dim olfolder As Object

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
Set olfolder = olapp.GetNamespace("mapi").PickFolder
  
    Set olappt = olfolder.Items.Add ' olAppointmentItem
 
   
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
    
    ' Set the Start Property Value
    .Start = Nz(Me.DelDate, "") & " " & Nz(Me.txtTime, "")
    .Subject = Nz(Me.Delivery & " " & Me.OrderNumber & " " & Me.Customer & " " & Me.NumberofDoors, vbNullString)
    .Mileage = Nz(Me.OrderNumber, vbNullString)
    .Categories = Nz(Me.Stage, vbNullString)
    .ReminderSet = False
   
         .Save
    End With
   
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
  
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub
Function isAppThere(appname) As Boolean
On Error Resume Next
   
    Dim objApp As Object
    isAppThere = True
   
    Set objApp = GetObject(, appname)
    If Err.Number <> 0 Then isAppThere = False
   
End Function

Any guidance is very much appreciated

 

[Michael Bauer]

I don't know what kind of folders PublicFolders creates. Is
"C2PublicFolders - Other User's Folders - HUNTLYJOINERY"
really one folder name? Probably not. If the first folder is "C2PublicFolders", see if it's a store, which you'd access via:
set olfolder=application.session.folders("C2PublicFolders")
From there you could access its next child folder by name.

 

[Melinda]

Thanks, I'll give it a shot. I have also attached a picture of the outlook structure as I see it using Pickfolder

 

[Michael Bauer]

Ok, so "C2PublicFolders" is indeed a store, which you can access as shown above.

Did you name this one "HUNTLYJOINERY\Tony"?

You shouldn't use the backslash within a folder name as it actually separates two folders. So, with the bs within the name, it is more difficult to identify by code what the next folder name is.

 

[Michael Bauer]

This one could be easier for you: Use the pickfolder to get the ref on the folder, then print its IDs:
debug.print olfolder,.entryid, olfolder.storeid

Copy the IDs from the debug window (strg+g), and replace the pickfolder in the code by this one:
set olfolder=application.session.getfolderfromid(entryid, storeid)

You'd need to do this on each computer as the IDs will be different on each one.

 

[Melinda]

Thanks for your help. This may be a stupid question, but where do I run debug.print olfolder,.entryid, olfolder.storeid
I added to my code after Pickfolder but got Compile error: Invalid or unqualified reference

 

[Michael Bauer]

Sorry, my fault, use this one:
debug.print olfolder.entryid, olfolder.storeid

 

[Melinda]

Thanks for the code. I am way out of my depth on this one.
I ran the debug.print and got the following:
00000000F6B257AFDA21B049BB29B33302C83EEC22810000

0000000038A1BB1005E5101AA1BB08002B2A56C200006D737073742E646C6C00000000004E495441F9BFB80100AA0037D96E0000000043003A005C00550073006500720073005C006D0065006C005C0044006F00630075006D0065006E00740073005C004F00750074006C006F006F006B002000460069006C00650073005C004F00750074006C006F006F006B002E007000730074000000

I tried to add this into my code and not only am I getting a Compile Error on .Session but I can't seem to get work the ID's into my code.
Sorry to be a pain, but could you maybe show my using my code how I should be doing it?

 

[Michael Bauer]

Show the code, please.

 

[Melinda]

This is my original code

Private Sub cmdAddCalendars_Click()
     Me.Dirty = False
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
Dim cat As Control
Dim olfolder As Object

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
Set olfolder = olapp.GetNamespace("mapi").PickFolder
 
    Set olappt = olfolder.Items.Add ' olAppointmentItem
  
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
   
    ' Set the Start Property Value
    .Start = Nz(Me.DelDate, "") & " " & Nz(Me.txtTime, "")
    .Subject = Nz(Me.Delivery & " " & Me.OrderNumber & " " & Me.Customer & " " & Me.NumberofDoors, vbNullString)
    .Mileage = Nz(Me.OrderNumber, vbNullString)
    .Categories = Nz(Me.Stage, vbNullString)
    .ReminderSet = False
  
         .Save
    End With
  
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
 
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub
Function isAppThere(appname) As Boolean
On Error Resume Next
  
    Dim objApp As Object
    isAppThere = True
  
    Set objApp = GetObject(, appname)
    If Err.Number <> 0 Then isAppThere = False
  
End Function

I have added your line below and
Dim StoreId As String
Dim EntryId As String
But when I tried to Set the Ids I got more errors. I haven't been able to find anything similar online to help me so I took them out again.

Private Sub cmdAddCalendar_Click()
     Me.Dirty = False
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
Dim cat As Control
Dim olfolder As Object
Dim StoreId As String
Dim EntryId As String

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
Set olfolder = Application.Session.GetFolderFromID(EntryId, StoreId)

    Set olappt = olfolder.Items.Add ' olAppointmentItem
 
   
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
    
    ' Set the Start Property Value
    .Start = Nz(Me.StartDate, "") & " " & Nz(Me.StartTime, "")
    .End = Nz(Me.EndDate, "") & " " & Nz(Me.EndTime, "")
    .Subject = Nz(Me.Employee & " Leave", vbNullString)
    .Mileage = Nz(Me.ID, vbNullString)
    .ReminderSet = False
   
         .Save
    End With
   
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
     'Return focus to Access
 
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation

End Sub
Function isAppThere(appname) As Boolean
On Error Resume Next
   
    Dim objApp As Object
    isAppThere = True
   
    Set objApp = GetObject(, appname)
    If Err.Number <> 0 Then isAppThere = False
   
End Function

 

[Michael Bauer]

You didn't paste both printed ID values.
EntryID="paste the printed value from the debug window here"
After that you can use the variable for the GetFolderFromID function.

 

[Melinda]

I have added both the ID's in but I am still get the following error for .Session

Compile Error: Method or Data Member not found

I tried setting the Session property but got the same error. Am I missing something?

Private Sub cmdAddCalendar_Click()
     Me.Dirty = False
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
Dim cat As Control
Dim olfolder As Object
Dim StoreId As String
Dim EntryId As String

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
EntryId = "00000000F6B257AFDA21B049BB29B33302C83EEC22810000"
StoreId = "0000000038A1BB1005E5101AA1BB08002B2A56C200006D737073742E646C6C00000000004E495441F9BFB80100AA0037D96E0000000043003A005C00550073006500720073005C006D0065006C005C0044006F00630075006D0065006E00740073005C004F00750074006C006F006F006B002000460069006C00650073005C004F00750074006C006F006F006B002E007000730074000000"
Set olfolder = Application.Session.GetFolderFromID(EntryId, StoreId)
    Set olappt = olfolder.Items.Add ' olAppointmentItem
 
   
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
    
    ' Set the Start Property Value
    .Start = Nz(Me.StartDate, "") & " " & Nz(Me.StartTime, "")
    .End = Nz(Me.EndDate, "") & " " & Nz(Me.EndTime, "")
    .Subject = Nz(Me.Employee & " Leave", vbNullString)
    .Mileage = Nz(Me.ID, vbNullString)
    .ReminderSet = False
   
         .Save
    End With
   
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
     'Return focus to Access
 
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation

End Sub
Function isAppThere(appname) As Boolean
On Error Resume Next
   
    Dim objApp As Object
    isAppThere = True
   
    Set objApp = GetObject(, appname)
    If Err.Number <> 0 Then isAppThere = False
   
End Function

 

[Michael Bauer]

Set olfolder = Application.Session.GetFolderFromID(EntryId, StoreId)

Is this line raising the error? If so, it doesn't run in Outlook, does it? If I'm right, use olapp.Session... as Application doesn't point to Outlook, but to the application the code runs in.

 

[Melinda]

Awesome! Thank you so much for your help...and patience.