title: Outlook Macro to save attachments from public mailbox
body: <p>I have the following macro, it all works fine but I would like it to read a public mailbox instead of the inbox, I would also like it to move the emails that have been processed to a different folder: </p>
  
  <pre><code>Option Explicit
  
  Sub SaveSubFolderAttachments()
      On Error GoTo SaveAttachmentsToFolder_err
  ' Declare variables
      Dim ns As NameSpace
      Dim Inbox As MAPIFolder
      Dim SubFolder As MAPIFolder
      Dim Item As Object
      Dim Atmt As Attachment
      Dim FileName As String
      Dim i As Integer
      Dim varResponse As VbMsgBoxResult
      Set ns = GetNamespace("MAPI")
      Set Inbox = ns.GetDefaultFolder(olFolderInbox)
      Set SubFolder = Inbox.Folders("Test") ' Enter correct subfolder name.
      i = 0
  ' Check subfolder for messages and exit of none found
      If SubFolder.Items.Count = 0 Then
          MsgBox "There are no messages in folder.", vbInformation, _
                 "Nothing Found"
          Exit Sub
      End If
  ' Check each message for attachments
      For Each Item In SubFolder.Items
          For Each Atmt In Item.Attachments
                  FileName = "S:\SME folder\Registrations\NKC Test Email Extract\" &amp; _
                      Format(Item.CreationTime, "yyyymmdd_hhnnss_") &amp; Atmt.FileName
                  Atmt.SaveAsFile FileName
                  i = i + 1
          Next Atmt
      Next Item
  ' Show summary message
      If i &gt; 0 Then
          varResponse = MsgBox("I found " &amp; i &amp; " attached files." _
          &amp; vbCrLf &amp; "I have saved them into the S:\SME folder\Registrations\NKC Test Email Extract\ folder." _
          &amp; vbCrLf &amp; vbCrLf &amp; "Would you like to view the files now?" _
          , vbQuestion + vbYesNo, "Finished!")
  ' Open Windows Explorer to display saved files if user chooses
          If varResponse = vbYes Then
              Shell "Explorer.exe /e,S:\SME folder\Registrations\NKC Test Email Extract\", vbNormalFocus
          End If
      Else
          MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
      End If
  ' Clear memory
  SaveAttachmentsToFolder_exit:
      Set Atmt = Nothing
      Set Item = Nothing
      Set ns = Nothing
      Exit Sub
  ' Handle Errors
  SaveAttachmentsToFolder_err:
      MsgBox "An unexpected error has occurred." _
          &amp; vbCrLf &amp; "Please note and report the following information." _
          &amp; vbCrLf &amp; "Macro Name: GetAttachments" _
          &amp; vbCrLf &amp; "Error Number: " &amp; Err.Number _
          &amp; vbCrLf &amp; "Error Description: " &amp; Err.Description _
          , vbCritical, "Error!"
      Resume SaveAttachmentsToFolder_exit
  End Sub
  </code></pre>