Excel VBA, set an Outlook Folder, which is a public folder

Question

I'm trying to move emails from an inbox folder (named "A_Classer") into a Outlook public folder (variable name for the destination folder is olFolder) I tried the getshareddefaultfolder method and the OpenSharedFolder method but I couldn't solve my syntax problem The name of the shared folder is "Québec" and it's path (from the property Windows) is ("Dossiers publics - [email protected]/Tous les dossiers publics/Québec") Code stops at : set olFolder...

Here's my code below with all the versions I tried

Sub move_to_public_folder()

Dim msg As Outlook.MailItem
Dim olFolder As Outlook.Folder         'public folder where I want the email to be moved
Dim sourceFolder As Outlook.Folder           'current folder of the emails that are to be moved
Dim OlApp As Object

Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient

Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
Set myNamespace = OlApp.GetNamespace("MAPI")

Set myRecipient = myNamespace.CreateRecipient("Guillaume Hébert")
myRecipient.Resolve
If myRecipient.Resolved Then
    Cells(1, 1) = Cells(1, 1) + 1
End If

Set olFolder = myNamespace.OpenSharedFolder("Québec")            'FIRST try I made
'Set olFolder = myNamespace.OpenSharedFolder _                    'Second try I made
    '("Dossiers publics - [email protected]/Tous les dossiers publics/Québec")
'Set olFolder = myNamespace.GetSharedDefaultFolder _              'Last try I made
                    '(myRecipient, olPublicFoldersAllPublicFolders)



Set sourceFolder = Session.GetDefaultFolder(sourceFolderInbox)
Set sourceFolder = sourceFolder.Folders("A_Classer")
If sourceFolder Is Nothing Then Exit Sub

I = sourceFolder.Items.Count
nbre_op = I                                                         'détermine combien de courriel dans le répertoire
I = 1
While I <= nbre_op
    Set msg = olFolder.Items(1)
    msg.Move olFolder
    I = I + 1
Wend

Set OlApp = Nothing

End Sub

Thank you in advance for all the help you will kindly provide

Answer 1

Are you connected to the Exchange server?

If you use the OpenSharedFolder method you need to specify the URL. This method is used to access the following shared folder types:

• Webcal calendars (webcal://mysite/mycalendar)
• RSS feeds (feed://mysite/myfeed)
• Microsoft SharePoint Foundation folders (stssync://mysite/myfolder)
• iCalendar calendar (.ics) files
• vCard contact (.vcf) files
• Outlook message (.msg) files

I'd recommend using the GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. For example, you can get the Inbox folder, then you can find the required one.

What error do you get in the code when you run the following line?

'Set olFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olPublicFoldersAllPublicFolders)

Answer 2

Found it! Tx to @Eugene and @xmojmr.

Sub move_to_public_folder()
    Dim msg As Outlook.MailItem
    Dim olFolder As Outlook.Folder         'source folder
    Dim objFolder As Outlook.Folder         'target folder
    'Dim sourceFolder As Outlook.Folder           'current folder of the emails that are to be moved
    Dim OlApp As Object
    'Dim fldr As Outlook.Folder
    Dim chemin_repertoire_outlook_cible As String       'path containing the target folder

    Dim myNamespace As Outlook.Namespace
    Dim myRecipient As Outlook.Recipient

    Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
    Set myNamespace = OlApp.GetNamespace("MAPI")

    Set myRecipient = myNamespace.CreateRecipient("Guillaume Hébert")
    myRecipient.Resolve
    If myRecipient.Resolved Then
        Cells(1, 1) = Cells(1, 1) + 1
    End If

    Set OlApp = CreateObject("Outlook.Application")                         'Outlook application call
    Set olFolder = Session.GetDefaultFolder(olFolderInbox)
    Set olFolder = olFolder.Folders("A_Classer")

    lig = 11
    col = 4

    chemin_repertoire_outlook_cible = Cells(lig, col)                'target folder name setting
    Set objFolder = GetFolder(chemin_repertoire_outlook_cible)
    I = olFolder.Items.Count
    nbre_op = I
    I = 1
    While I <= nbre_op                                       'loop to move all msg in source folder (olFolder)
        Set msg = olFolder.Items(1)
        msg.Move objFolder
        I = I + 1
    Wend

 Set OlApp = Nothing
End Sub

The function GetFolder is as follow

Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' source of this function is:  http://www.outlookcode.com/d/code/getfolder.htm
  ' strFolderPath needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales" or
  '   "Personal Folders\Inbox\My Folder"

  Dim objApp As Outlook.Application
  Dim objNS As Outlook.Namespace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.Folder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next


  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = Outlook.Application
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  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 GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing

End Function

Hope it could help someone else sometime.