Outlook宏以保存公共邮箱附件

Question

我有以下宏，它一切正常，但我希望它读取公共邮箱，而不是收件箱，我也想它将已处理的电子邮件不同的文件夹：

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\" & _ 
        Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName 
       Atmt.SaveAsFile FileName 
       i = i + 1 
     Next Atmt 
    Next Item 
' Show summary message 
    If i > 0 Then 
     varResponse = MsgBox("I found " & i & " attached files." _ 
     & vbCrLf & "I have saved them into the S:\SME folder\Registrations\NKC Test Email Extract\ folder." _ 
     & vbCrLf & vbCrLf & "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." _ 
     & vbCrLf & "Please note and report the following information." _ 
     & vbCrLf & "Macro Name: GetAttachments" _ 
     & vbCrLf & "Error Number: " & Err.Number _ 
     & vbCrLf & "Error Description: " & Err.Description _ 
     , vbCritical, "Error!" 
    Resume SaveAttachmentsToFolder_exit 
End Sub 

Answer 1

通过“公共邮箱”，你的意思是另一个用户的邮箱吗？使用GetSharedDefaultFolder而不是GetDefaultFolder。