Outlook VBA Adapt code for using in a different Mail Inbox

Hello, friends. I'm trying to adapt this code (From user Graham Mayor) for using in a different Mail Inbox named "workgroup" but I don't get it. I don't know if is necessary to replace entire name "myinbox" or create other route.

In adiccion, I'm trying to categorize my eMails with a blue color, but at the moment I only got it put a name "Susi".
someone for helping me? thanks in advance!

Public Sub NewInbox_Su ()

'original code from Graham Mayor www.gmayor.com

Dim myNameSpace As Outlook.NameSpace

Dim myInbox As Outlook.Folder 'Here is my first doubt, I don't know how to refer other Inbox

Dim myItem As MailItem

Dim lngCount As Long



Set myNameSpace = Application.GetNamespace("MAPI")

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)

MsgBox myInbox.UnReadItemCount

If myInbox.UnReadItemCount > 0 Then

For lngCount = myInbox.Items.Count To 1 Step -1



If TypeName(myInbox.Items(lngCount)) = "MailItem" Then

If myInbox.Items(lngCount).UnRead = True Then

Set myItem = myInbox.Items(lngCount)

If InStr(LCase(myItem.Body), "alarm") > 0 Or _

InStr(LCase(myItem.Subject), "urgent") > 0 Then

myItem.Categories = "Susi" 'Here is my second doubt, I don't know how to put a blue color
myItem.Save
myiTem.Unread = False

End If

End If

End If

DoEvents



Next lngCount

End If

Set myNameSpace = Nothing

Set myInbox = Nothing

Set myItem = Nothing


End Sub

You need to insert the path to the folder e.g. as here by looping through the various stores available

Code:

---

Public Sub NewInbox_Su()
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Jan 2021
Dim myNameSpace As Outlook.NameSpace
Dim oStore As Outlook.Store
Dim myInbox As Outlook.Folder
Dim myItem As MailItem
Dim lngCount As Long

    Set myNameSpace = Application.GetNamespace("MAPI")
    For Each oStore In myNameSpace.Stores
        If oStore.DisplayName = "Account Display Name" Then 'insert the account display name here
            Set myInbox = oStore.GetRootFolder.folders("Inbox")
            MsgBox myInbox.UnReadItemCount
            If myInbox.UnReadItemCount > 0 Then
                For lngCount = myInbox.items.Count To 1 Step -1
                    If TypeName(myInbox.items(lngCount)) = "MailItem" Then
                        If myInbox.items(lngCount).UnRead = True Then
                            Set myItem = myInbox.items(lngCount)
                            If InStr(LCase(myItem.Body), "alarm") > 0 Or _
                              InStr(LCase(myItem.Subject), "urgent") > 0 Then
                                myItem.Categories = "Blue Category"
                                myItem.Save
                                myItem.UnRead = False
                            End If
                        End If
                    End If
                    DoEvents
                Next lngCount
            End If
            Exit For
        End If
    Next oStore

    Set oStore = Nothing
    Set myNameSpace = Nothing
    Set myInbox = Nothing
    Set myItem = Nothing
End Sub

---

Hello Graham! First of all, Thank you! I tried to replace the name of my new Inbox there: (the new Inbox named WORKGROUP) but it doesn't work... stopped here "Next oStore"

If oStore.DisplayName = "WORKGROUP" Then 'insert the account display name here
Set myInbox = oStore.GetRootFolder.folders("Inbox")

Then stopped here: Next oStore

"Run-time error '-1698234242 (9ac7007e)'

Automation Error.

I've revised all references and I think are ok...

Hmmm. Check the available stores with the following macro, which will write the names to the immediate window:

Code:

---

Sub Test()
Dim myNameSpace As Outlook.NameSpace
Dim oStore As Outlook.Store
    Set myNameSpace = Application.GetNamespace("MAPI")
    For Each oStore In myNameSpace.Stores
Debug.Print oStore.DisplayName
    Next oStore
End Sub

---

Hello Graham! I checked the available stores with your macro (test) and I have a similar problem... ("Run-time error -941162370 (c7e7007e) Automation Error. So I think the problem is mine and not in your code... I don't know what's going on... where is the problem? Thank you!

No idea, without access - but see https://www.slipstick.com/developer/...olders/#shared

Hello, bytheway! Sttopped here again
Next oStore

I only have one store... maybe this is the problem?

Morning gmayor,

I've received a possible solution but I don't know in which part of your code I need include this:

The way to avoid the error is to use a for loop (docs.microsoft.com/en-us/office/vba/language/reference/…) rather than a for each loop, iterate backwards for x = myNameSpace.Stores.Count to 1 step -1 and check for existance before actioning if not myNameSpace.Stores(x) is nothing then. I don't remember if the Stores collection is 1 or zero based, you may need for x = myNameSpace.Stores.Count -1 to 0 step -1. –

Can you helping me? Thank you!