VBA脚本在Outlook共享邮箱中移动具有特定主题的邮件会收到错误``需要对象''

Question

我正在尝试编写一个宏，该宏将具有特定主题的所有传入消息（在这种情况下为“测试”）移动到另一个文件夹。整个事情应该发生在共享邮箱中。

我在此行上收到“需要对象”错误：

Set objDestFolder = olApp.GetNamespace("MAPI").Folders("Digital Office").Folders("Inbox").Folders(moveFolder) '

到目前为止我所拥有的：

首先保存在模块中，这是要在非默认邮箱中查找文件夹：

' Use the GetFolderPath function to find a folder in non-default mailboxes
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

然后我在“ ThisOutlookSession”中有以下代码：

Dim i As Long
Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  Set olInboxItems = GetFolderPath("Digital Office\Inbox").Items
Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    Dim objDestFolder As Outlook.MAPIFolder
    Dim moveFolder As String

    If Item.Subject = "test" Then


    moveFolder = "Test"


Set objDestFolder = olApp.GetNamespace("MAPI").Folders("Digital Office").Folders("Inbox").Folders(moveFolder) ' Destination Folder
  Item.Move objDestFolder
        End If

        Err.Clear

 Set objDestFolder = Nothing
 End Sub