2

I have two accounts in Outlook one is my personal and another is shared.
I want to read or unread emails of my shared mail box.

I have code that is working with my personal Inbox.

With my shared email group it is showing
automation error pop-up

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
greybeard
  • 2,249
  • 8
  • 30
  • 66
AMISH HUSAIN
  • 45
  • 1
  • 6
  • Why is there is there a column `:` after the `Else` ? – Pac0 Oct 10 '17 at 08:04
  • On a side note, I recommend using `Return` or `End Sub` instead of the `GoTo` and the label at the end, for clarity and maintanability. – Pac0 Oct 10 '17 at 08:07
  • This code is working in personal Account but not in shared account. So is there any changes needed for running in shared Account. – AMISH HUSAIN Oct 10 '17 at 14:19
  • "Not working" as in "giving you an error"? What is it? – Dmitry Streblechenko Oct 10 '17 at 15:28
  • Also, this is multiple dot notation take in its extreme - do not use Folder.Items(iRow) over and over again inside the loop. Cache the item once at the begging of the loop in a variable. – Dmitry Streblechenko Oct 10 '17 at 15:29
  • Thank you for the suggestion regarding folder.item(iRow). I have attached the screen shot of error code in the image. It's basically Automation Error. – AMISH HUSAIN Oct 10 '17 at 15:36
  • Apparently the error is not reproducible. Remove as much code as you can from the question. https://stackoverflow.com/help/mcve Point out the line that generates the error. – niton Oct 10 '17 at 19:42
  • I am getting error on this (it is working in personal mail box but not on shared) Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_Name) – AMISH HUSAIN Oct 11 '17 at 14:15
  • This requires the folder to be in the navigation pane. If it is, then there is a typo. You can break the line into two. `Set Folder = Outlook.Session.folders(MailboxName) ` followed by `Set Folder = Folder.folders(Pst_Folder_Name)` to pinpoint the problem. – niton Oct 11 '17 at 17:26
  • There is no typo error. If there was a typo then this would have not worked in personal mail box. Also, breaking the code will not help. – AMISH HUSAIN Oct 12 '17 at 06:45
  • The code should work if the other mailbox is as described here https://stackoverflow.com/questions/9076634/get-reference-to-additional-inbox otherwise you would use the alternate method GetSharedDefaultFolder. – niton Oct 12 '17 at 12:43

1 Answers1

3

Hi you can try with the below code(I have edit your above posted code) and also remove unusual code according to your need.

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
Sukhvindra Singh
  • 200
  • 2
  • 14