无法修改 VBA 宏以适应共享邮箱

Question

所以这个 VBA 宏目前可以很好地从我的个人收件箱（Outlook 已经打开）下载附件。它从当天收到的指定子文件夹（例如 Inbox\Holidays）下载附件，并将它们保存到目标文件夹中。

我已经尝试过，但在修改它以执行相同但共享邮箱的问题时遇到了问题。 关于实现此目标我需要进行哪些更改的任何想法？我的 Outlook 帐户也有多个共享邮箱，因此它需要一些参数来告诉它读取哪个邮箱。

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                             ExtString As String, destfolder As String)
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 MyDocPath As String
Dim I As Integer
Dim wsh As Object
Dim fs As Object

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

'Create DestFolder if DestFolder = ""
If destfolder = "" Then
    Set wsh = CreateObject("WScript.Shell")
    Set fs = CreateObject("Scripting.FileSystemObject")
    MyDocPath = wsh.SpecialFolders.Item("mydocuments")
    destfolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss")
    If Not fs.FolderExists(destfolder) Then
        fs.CreateFolder destfolder
    End If
End If

If Right(destfolder, 1) <> "\" Then
    destfolder = destfolder & "\"
End If

' Check each message for attachments and extensions
For Each Item In SubFolder.Items
    If Format(Item.ReceivedTime, "MM-DD-YYYY") = Format(Date, "MM-DD-YYYY") Then
        For Each Atmt In Item.Attachments
            If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                ' FileName = DestFolder & Item.SenderName & " " & Atmt.FileName
                FileName = destfolder & " " & Atmt.FileName
                Atmt.SaveAsFile FileName
                I = I + 1
            End If
        Next Atmt
    End If
Next Item

结束子