Outlook VBA Adapt code for using in a different Mail Inbox

[Su_80]

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

[gmayor]

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


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

[Su_80]

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...

[gmayor]

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


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

[Su_80]

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!

[gmayor]

No idea, without access - but see https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#shared

[Su_80]

Hello, bytheway! Sttopped here again
Next oStore

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

[Su_80]

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!