如何在Outlook VBA中引用非默认邮箱账户？

问题背景 #

原代码仅适配单邮箱账户的Outlook配置，我使用Outlook 2016（x64）双账户环境，需要从非默认账户planner@gmail.com的收件箱移动邮件。修改代码时错误地将命名空间变量指向了账户文件夹，运行后触发错误13：类型不匹配。

错误修改的代码行：

Set olNs = Application.GetNamespace("MAPI").Folders("planner@gmail.com")

错误提示：

An unexpected Error has occurred. Error number: 13. Error Description: Type mismatch

错误原因 #

olNs被声明为Outlook.NameSpace类型，但Application.GetNamespace("MAPI").Folders("账户名")返回的是MAPIFolder对象，变量类型与赋值对象不匹配，导致类型错误。

修正后的代码 #

Option Explicit
Public Sub Move_Items_From_NonDefault_Account()
    ' 声明变量
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim targetAccountFolder As Outlook.MAPIFolder ' 存储目标账户的根文件夹
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr

    ' 获取MAPI命名空间
    Set olNs = Application.GetNamespace("MAPI")
    ' 获取非默认账户planner@gmail.com的根文件夹
    Set targetAccountFolder = olNs.Folders("planner@gmail.com")
    ' 获取该账户的收件箱
    Set Inbox = targetAccountFolder.Folders("收件箱")
    Set Items = Inbox.Items

    ' 倒序遍历收件箱项目（避免删除/移动时索引混乱）
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
            ' 获取收件箱下的Temp子文件夹
            Set SubFolder = Inbox.Folders("Temp")
            ' 标记为已读
            Item.UnRead = False
            ' 移动邮件到子文件夹
            Item.Move SubFolder
        End If
    Next lngCount

MsgErr_Exit:
    ' 释放对象
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set targetAccountFolder = Nothing
    Set Item = Nothing

    Exit Sub

' 错误处理
MsgErr:
    MsgBox "发生意外错误。" _
         & vbCrLf & "错误代码: " & Err.Number _
         & vbCrLf & "错误描述: " & Err.Description _
         , vbCritical, "错误提示!"
    Resume MsgErr_Exit
End Sub

关键修改点 #

• 新增targetAccountFolder变量，专门存储目标账户的根文件夹（类型为MAPIFolder）
• 保持olNs为NameSpace类型，通过它获取目标账户文件夹后，再从中提取收件箱
• 确保每个变量的类型与赋值对象严格匹配，避免类型不匹配问题

内容的提问来源于stack exchange，提问作者Planner