Question

我在Outlook中有2个帐户，一个是我的个人，另一个是共享的。我想读取或读取共享邮箱的电子邮件。我有一个代码可以使用我的电子邮件收件箱，但不能与我的共享电子邮件群组一起使用。

我的代码如下：

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

'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 = "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

如何使用Excel VBA阅读Outlook中共享电子邮件中的电子邮件

1 个答案: