如何訪問共享郵箱中的電子郵件？

Question

我在 Outlook 中有兩個帳戶，一個是我的個人帳戶，另一個是共享帳戶。
我想閱讀或未讀我的共享郵箱的電子郵件。

我有與我的個人收件箱配合使用的代碼。

我的共享電子郵件組顯示

Sub OutlookTesting()
    Dim folders As Outlook.folders
    Dim Folder As Outlook.MAPIFolder
    Dim iRow As Integer
    Dim Pst_Folder_Name
    Dim MailboxName
    Dim UnRow As Integer
    Dim RESS As Outlook.Recipient
    Dim Flag As Integer
    
    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
    MailboxName = "Dummi@abc.com" 'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "Inbox"
    
    ' subfolder name
    Dim subFolderName As String
    subFolderName = "XYZ"
    
    Set Folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_Name)
    If Folder = "" Then
        MsgBox "Invalid Data in Input"
        GoTo end_lbl1:
    End If
    
    'Read Through each Mail and export the details to Excel for Email Archival
    For iRow = 1 To Folder.Items.Count
        If (Folder.Items(iRow).UnRead) Then
            Flag = 0
            Set Res = Folder.Items(iRow).Recipients
                For Each RESS In Res
                    If RESS.Name = "ABCD" Or RESS.Name = "PQRS" Then
                      Flag = 1
                    End If
                Next
                If Flag = 1 Then
                    Folder.Items(iRow).UnRead = True
                Else: Folder.Items(iRow).UnRead = False
                End If
            End If
        Next iRow
        MsgBox "Outlook Mails Extracted to Excel"
end_lbl1:
End Sub

Answer 1

嗨，您可以嘗試使用以下代碼（我已經編輯了您上面發布的代碼）並根據您的需要刪除了異常代碼。

Sub OutlookTesting()
Dim folders As Outlook.folders
Dim folder As Outlook.MAPIFolder
Dim iRow As Integer
Dim Pst_Folder_Name
Dim MailboxName
Dim UnRow As Integer
Dim RESS As Outlook.Recipient
Dim Flag As Integer
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfldr As Outlook.MAPIFolder
Dim foldername As Outlook.MAPIFolder
Dim sharedemail As Outlook.Recipient


Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient("youremail@abc.com")
Set olfldr = olNS.GetSharedDefaultFolder(sharedemail, olFolderInbox)


Set folder = olfldr

If folder = "" Then
   MsgBox "Invalid Data in Input"
   GoTo end_lbl1:
End If

'Rad Through each Mail and export the details to Excel for Email Archival

For iRow = 1 To folder.Items.Count
    If (folder.Items(iRow).UnRead) Then
        Flag = 0
        Set Res = folder.Items(iRow).Recipients
            For Each RESS In Res
                If RESS.Name = "XYZ" Or RESS.Name = "ABC" Then
                  Flag = 1
                End If
            Next
            If Flag = 1 Then
                  folder.Items(iRow).UnRead = True
                    Else: folder.Items(iRow).UnRead = False
                End If
    End If
Next iRow
MsgBox "Outlook Mails Extracted to Excel"
end_lbl1:
End Sub