如何使用VBA访问无法添加至账户的共享邮箱？

你的代码核心问题在于变量类型不匹配+赋值逻辑错误：

• 你将sharedmailbox声明为Outlook.Recipient类型，但直接给它赋值objectNS.CreateRecipient("shared@email.com").Folders("subfolder").Items，这会把Items对象塞进Recipient变量里，导致后续GetSharedDefaultFolder调用失败，返回Nothing。
• CreateRecipient返回的是收件人对象，不能直接链式调用文件夹和Items，必须先正确解析收件人，再获取对应文件夹。

修正后的代码（获取共享邮箱默认收件箱） #

Option Explicit
Const xlUp As Long = -4162 'Set the enumeration for Excel's xlup
Private WithEvents inboxItems As Outlook.Items

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace
    Dim sharedRecipient As Outlook.Recipient
    Dim sharedInbox As Outlook.Folder
    
    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    
    ' 创建并解析共享邮箱收件人
    Set sharedRecipient = objectNS.CreateRecipient("shared@email.com")
    ' 必须调用Resolve确保能找到该共享邮箱
    If sharedRecipient.Resolve Then
        ' 获取共享邮箱的默认收件箱
        Set sharedInbox = objectNS.GetSharedDefaultFolder(sharedRecipient, olFolderInbox)
        ' 绑定收件箱的Items集合
        Set inboxItems = sharedInbox.Items
    Else
        MsgBox "无法找到指定的共享邮箱"
    End If
End Sub

如果需要访问共享邮箱默认收件箱下的子文件夹 #

Option Explicit
Const xlUp As Long = -4162 'Set the enumeration for Excel's xlup
Private WithEvents subFolderItems As Outlook.Items

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace
    Dim sharedRecipient As Outlook.Recipient
    Dim sharedInbox As Outlook.Folder
    Dim targetSubFolder As Outlook.Folder
    
    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    
    Set sharedRecipient = objectNS.CreateRecipient("shared@email.com")
    If sharedRecipient.Resolve Then
        Set sharedInbox = objectNS.GetSharedDefaultFolder(sharedRecipient, olFolderInbox)
        ' 定位默认收件箱下的子文件夹
        On Error Resume Next ' 防止子文件夹不存在报错
        Set targetSubFolder = sharedInbox.Folders("subfolder")
        On Error GoTo 0
        
        If Not targetSubFolder Is Nothing Then
            Set subFolderItems = targetSubFolder.Items
        Else
            MsgBox "共享邮箱收件箱下未找到指定子文件夹"
        End If
    Else
        MsgBox "无法找到指定的共享邮箱"
    End If
End Sub

关键注意事项 #

• 必须调用Recipient.Resolve()：确保Outlook能正确识别共享邮箱的身份，这是访问共享邮箱的前提
• 变量类型要严格匹配：Recipient对象只能用于传递给GetSharedDefaultFolder，不能直接赋值为文件夹或Items对象
• 错误处理：添加必要的错误判断，避免因邮箱不存在、子文件夹不存在导致代码崩溃

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