3

I have written the following code in Excel VBA that opens an email with the given subject if located in the default inbox folder in Outlook.

However, I would like to search for this email in all inbox subfolders.

Because the code will be used by several users, I do not know the number and the name of their outlook inbox subfolders. Any ideas on how I could search this email in all subfolders?

Sub GetEmail()

    Dim OutApp as Object
    Dim Namespace as Object
    Dim Folder as Object
    Dim myMail as Object

    Set OutApp = CreateObject("Outlook.Application")
    Set Namespace = OutApp.GetNamespace ("MAPI")
    Set Folder = Namespace.GetDefaultFolder(6)

    Set myMail = Folder.Items.Find ("[Subject] = ""Test""")

    myMail.Display


End Sub
Trs
  • 63
  • 2
  • 2
  • 8
  • Just a quick thought, you could just do the search in Outlook, why do you want to create a function in Excel?. If you really want such a function (which kinda seems a duplication of the search functionality in Outlook) you could just write a macro in Outlook – Zac Jul 27 '17 at 09:32
  • There are pros and cons: If you write a macro in Outlook to do this, it's easier as you already have access to outlook object but you will have to add the macro in outlook for all users. In Excel, It's a bit more .. complicated to write the macro but you don't need any installation – Zac Jul 27 '17 at 09:45
  • 1
    Possible duplicate of [Can I iterate through all Outlook emails in a folder including sub-folders?](https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders) – niton Jul 27 '17 at 16:29

1 Answers1

8

The below code cycles through all folders in Outlook, to the level one beneath the Inbox. You can just look at the inbox by specifying the initial folder to look at. Thus you can search the folder as you loop through. you can add further sub folders by looping deeper, or by saying folders.count > X.

I have always found Outlook from Excel frustrating so have made this Early Bound to make coding easier. This means that you will need to go to Tool/References and add Microsoft Outlook 16(x).0 Object Library

You can change it back to late bound after coding, as early binding will give you IntelliSense and make life a whole lot easier.

Sub GetEmail()

Dim OutApp As Outlook.Application
Dim Namespace As Outlook.Namespace
Dim Mfolder As Outlook.MAPIFolder
Dim myMail As Outlook.Items

Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim UserFolder As Outlook.MAPIFolder

Set OutApp = New Outlook.Application
Set Namespace = OutApp.GetNamespace("MAPI")

On Error Resume Next
For Each Folder In Namespace.Folders
    For Each SubFolder In Folder.Folders
        For Each UserFolder In SubFolder.Folders
            Debug.Print Folder.Name, "|", SubFolder.Name, "|", UserFolder.Name
        Next UserFolder
    Next SubFolder
Next Folder
On Error GoTo 0

End Sub

The on error is to skip any issues with outlook mapping Archive pst files.

  • A thousand thanks for your help Keith! Everytime I try to add the Microsoft Outlook 16(x).0 Object Library to use early binding a message appears saying "Name conflicts with existing module, project, or object library". But when I define objects like: Dim OutApp As Outlook.Application, it still appears: "Compile error - User-defined type not defined". Any chance you know why? – Trs Jul 27 '17 at 10:45
  • I think (and I'm not 100% sure) that might be referencing. Are you using set outapp = New outlook.(whatever). I seem to remember something like that when using FileSystemObject. – Keith Whatling Jul 27 '17 at 15:55
  • 1
    @Keith where the number of levels is unknown there is this https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders – niton Jul 27 '17 at 16:31
  • No, I am just using the createobject("Outlook.Application"), createitem(), etc! – Trs Jul 27 '17 at 16:54
  • The best person to look at for early v late bound code and how to is good old Ron https://www.rondebruin.nl – Keith Whatling Jul 28 '17 at 10:19