J
jack
I tried using the following code to access custom subfolders in another
users shared mailbox
however it returns an empty object, what am I doing wrong ?? (outlook 2003)
thanx for help in advance, Jack
Public Function GetSharedFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Sales Department\Company\Sales"
' where first folder in path is the shared mailbox's fully resolvable name
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim myRecipient As Outlook.Recipient
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set myRecipient = objNS.CreateRecipient(arrFolders(0))
Set objFolder = _
objNS.GetSharedDefaultFolder(myRecipient, olFolderSharedRoot)
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetSharedFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
users shared mailbox
however it returns an empty object, what am I doing wrong ?? (outlook 2003)
thanx for help in advance, Jack
Public Function GetSharedFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Sales Department\Company\Sales"
' where first folder in path is the shared mailbox's fully resolvable name
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim myRecipient As Outlook.Recipient
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set myRecipient = objNS.CreateRecipient(arrFolders(0))
Set objFolder = _
objNS.GetSharedDefaultFolder(myRecipient, olFolderSharedRoot)
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetSharedFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function