title: Moving Emails to Public Folder using Dynamic Paths
body: <p>In our Corporate environment we have a Mailbox (not the default inbox) with many sub folders. We also have a Public Folder which is an exact mirror of the Mailbox folder structure.</p>
  
  <p>I am trying to detect the path of a selected email and move that email to its mirrored folder in the Public Folders.</p>
  
  <p>I would say 95% of this code is correct but I am left with an Outlook error message "Can't move the items."</p>
  
  <p>The code is supposed to do the following:<br>
  1. detects the current folder of the selected email(s)<br>
  2. converts the MAPIFolder into a path string<br>
  3. shortens the string to remove the root Mailbox directory structure<br>
  4. adds the remaining string onto the root directory structure of the public folder<br>
  5. converts the resulting path back into a MAPIFolder<br>
  6. move the selected email(s) to the mirrored folder in the Public Folders</p>
  
  <pre class="lang-vb prettyprint-override"><code>Sub PublicFolderAutoArchive()
  
      Dim olApp As Object
      Dim currentNameSpace As NameSpace
      Dim wipFolder As MAPIFolder
      Dim objFolder As MAPIFolder
      Dim pubFolder As String
      Dim wipFolderString As String
      Dim Messages As Selection
      Dim itm As Object
      Dim Msg As MailItem
      Dim Proceed As VbMsgBoxResult
  
      Set olApp = Application
      Set currentNameSpace = olApp.GetNamespace("MAPI")
      Set wipFolder = Application.ActiveExplorer.CurrentFolder
      Set Messages = ActiveExplorer.Selection
  
      ' Destination root directory'
      ' Tried with both "\\Public Folders" and "Public Folders" .. neither worked
      pubFolder = "\\Public Folders\All Public Folders\InboxMirror"
  
      ' wipFolder.FolderPath Could be any folder in our mailbox such as:  
      ' "\\Mailbox - Corporate Account\Inbox\SubFolder1\SubFolder2"
      ' however, the \\Mailbox - Corporate Account\Inbox\" part is 
      ' static and never changes so the variable below removes the static
      ' section, then the remainder of the path is added onto the root 
      ' of the public folder path which is an exact mirror of the inbox.
      ' This is to allow a dynamic Archive system where the destination 
      'path matches the source path except for the root directory.
      wipFolderString = Right(wipFolder.FolderPath, Len(wipFolder.FolderPath) - 35)
  
      ' tried with and without the &amp; "\" ... neither worked
      Set objFolder = GetFolder(pubFolder &amp; wipFolderString &amp; "\")
  
      If Messages.Count = 0 Then
          Exit Sub
      End If
  
      For Each itm In Messages
          If itm.Class = olMail Then
              Proceed = MsgBox("Are you sure you want archive the message to the Public Folder?", _
              vbYesNo + vbQuestion, "Confirm Archive")
              If Proceed = vbYes Then
                  Set Msg = itm
                  Msg.Move objFolder
              End If
          End If
      Next
  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>
  
  <p>Note: The mailbox above is just an example and is not the actual mailbox name. I used MsgBox to confirm the path string was being joined correctly with all appropriate back slashes and that the Right() function was getting what I needed from the source path.</p>