title: Public folders in vba
body: <p>I am struggling to find out how i can create public folders from a word macro, for time being i am debugging right in outlook. The problem is that my macro will be run by several user and hence i can not hardcode in "public folders -xxxx@xxx.no" So is there a way to avoid this?</p>
  
  <pre><code>    Sub AddContactsFolder()
       Dim myNameSpace As Outlook.NameSpace
       Dim myFolder As MAPIFolder
       Dim myNewFolder As MAPIFolder
  
       Set myNameSpace = Application.GetNamespace("MAPI")
      'Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
      'Set myFolder = myNameSpace.GetSharedDefaultFolder(
  
      'Set myFolder = GetFolder("Public Folders - xxxx@xxxx.no/All Public Folders/Prototech/")
      'fails below .....
      Set myFolder = GetFolder("Public Folders - *.xxxxx.no/All Public Folders/Prototech/Avd. 150 R&amp;D") '.Folders.Add("Test")
      Set myNewFolder = myFolder.Folders.Add("AAAAA")
      End Sub
  
  
      Public Function GetFolder(strFolderPath As String) As MAPIFolder
        ' 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.MAPIFolder
        Dim arrFolders() As String
        Dim I As Long
        On Error Resume Next
  
        strFolderPath = Replace(strFolderPath, "/", "\")
        arrFolders() = Split(strFolderPath, "\")
        Set objApp = 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
  </code></pre>