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

问题描述：

我在Outlook中有2个帐户，一个是我的个人，另一个是共享的。我想阅读或阅读我的共享邮箱中的未读邮件。我有一个正在使用我的电子邮件收件箱的代码，但没有与我的共享电子邮件组一起工作。如何使用Excel VBA读取Outlook中的共享电子邮件中的电子邮件

它显示错误enter image description here

我的代码如下：

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 = "[email protected]" '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

为什么在'Else'之后有''''列？ – Pac0

在附注中，我建议使用'Return'或'End Sub'来代替末尾的 'GoTo'和标签，以保证清晰度和可维护性。 – Pac0

此代码在个人帐户中工作，但不在共享帐户中。因此，在共享帐户中运行需要进行任何更改。 –

答

嗨，你可以用下面的代码尝试（我有编辑你上面贴的代码），并删除根据不同寻常的代码你需要。

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("[email protected]") 
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中的共享电子邮件中的电子邮件

相关推荐