How to link to MS Access to Outlook Custom Search Box

Hello Team

I have a MS Access database that links to multiple outlook folders.  

One of the folders that I would like to link to is a custom search folder (Emails Per Day)  that captures and counts how many emails are received into my mailbox each day.  

When attempting to link my MS Access database, I can't find the custom search folder I created.

I am thinking that it may not be possible to link to it as it is not visible on the Import\Exchange Outlook Wizard in MS Access.

Can you please advise if it is not possible to directly link via the wizard, is there anyway around this, e.g., VBA?


Thanks in advance to any responses received.

Sincerely

Dale
Dale JamesTherapistAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
Here's a sample that should get you going

' EnumerateSearchFolderItems "Emails Per Day"
Sub EnumerateSearchFolderItems(ByVal sSearchFolderName As String)
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oStores               As Object    'Outlook.Stores
    Dim oStore                As Object    'Outlook.Store
    Dim oSearchFolders        As Object    'Outlook.folders
    Dim oFolder               As Object    'Outlook.folder

    On Error Resume Next

    Set oOutlook = GetObject(, "Outlook.Application")
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oStores = oNameSpace.Session.Stores
    For Each oStore In oStores
        Set oSearchFolders = oStore.GetSearchFolders
        For Each oFolder In oSearchFolders
            If oFolder.Name = sSearchFolderName Then
                With oFolder
                    For i = 1 To .Items.Count
                        Debug.Print .Items.Item(i).SenderName, .Items.Item(i).Subject, .Items.Item(i).ReceivedTime, .Items.Item(i).Categories
                    Next i
                End With
            End If
        Next
    Next

    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oSearchFolders Is Nothing Then Set oSearchFolders = Nothing
    If Not oStore Is Nothing Then Set oStore = Nothing
    If Not oStores Is Nothing Then Set oStores = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
End Sub

Open in new window

or even better
' EnumerateSearchFolderItems "Emails Per Day"
Sub EnumerateSearchFolderItems(ByVal sSearchFolderName As String)
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oStores               As Object    'Outlook.Stores
    Dim oStore                As Object    'Outlook.Store
    Dim oFolder               As Object    'Outlook.folder

    On Error Resume Next

    Set oOutlook = GetObject(, "Outlook.Application")
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oStores = oNameSpace.Session.Stores
    For Each oStore In oStores
        Set oFolder = oStore.GetSearchFolders.Item(sSearchFolderName)
        If Not oFolder Is Nothing Then
            With oFolder.items
                For i = 1 To .Count
                    Debug.Print i, .Item(i).SenderName, .Item(i).Subject, .Item(i).ReceivedTime, .Item(i).Categories
                Next i
            End With
            Exit For
        End If
    Next

    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oStore Is Nothing Then Set oStore = Nothing
    If Not oStores Is Nothing Then Set oStores = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
End Sub

Open in new window

Dale JamesTherapistAuthor Commented:
Hello Daniel

Thank you very much for providing the above code.

I placed the code in an Access module with the code to be triggered by a Command Click.  When the code is triggered the Complie Error messages appears stating, Argument Not Optional.

I see that there is an argument sSearchFolderName, but I am not sure what I should be providing to this argument, can you please advise?

Sincerely

Dale.
Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
EnumerateSearchFolderItems "Emails Per Day"

assuming "Emails Per Day" is the name of your Search Folder.

Don't forget, my sub just prints a few properties to the VBE immediate window.  You'll need to customize it to do what you want.  If all you want is the count of items within the folder then you only need to extract the .Count value.
Exploring SQL Server 2016: Fundamentals

Learn the fundamentals of Microsoft SQL Server, a relational database management system that stores and retrieves data when requested by other software applications.

Dale JamesTherapistAuthor Commented:
Thanks again Daniel..

Still getting the compile error so am obviously not applying the code correctly.

So just to recap to see where I am going wrong here.

I have created a custom search folder called "Emails Per Day".  Placed the provided code in an Access module and linked it to be triggered by a command button with a click event.

Still not sure how I am to pass the required argument.

My apologies for requesting further assistance.

Dale
Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
Your click event should be something like

EnumerateSearchFolderItems "Emails Per Day"

Open in new window

or
Call EnumerateSearchFolderItems("Emails Per Day")

Open in new window




There was a compile error because I forgot to declare i, so here is an updated version of the code.
' EnumerateSearchFolderItems "Emails Per Day"
Sub EnumerateSearchFolderItems(ByVal sSearchFolderName As String)
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oStores               As Object    'Outlook.Stores
    Dim oStore                As Object    'Outlook.Store
    Dim oFolder               As Object    'Outlook.folder
    Dim i                     As Long

    On Error Resume Next

    Set oOutlook = GetObject(, "Outlook.Application")
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oStores = oNameSpace.Session.Stores
    For Each oStore In oStores
        Set oFolder = oStore.GetSearchFolders.Item(sSearchFolderName)
        If Not oFolder Is Nothing Then
            With oFolder.items
                For i = 1 To .Count
                    Debug.Print i, .Item(i).SenderName, .Item(i).Subject, .Item(i).ReceivedTime, .Item(i).Categories
                Next i
            End With
            Exit For
        End If
    Next

    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oStore Is Nothing Then Set oStore = Nothing
    If Not oStores Is Nothing Then Set oStores = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Dale JamesTherapistAuthor Commented:
Hello Daniel

All is working perfect now.

Thank you so much for all your assistance and patience with this initial request.

Sincerely

Dale
Daniel PineaultPresident / Owner CARDA Consultants Inc.Commented:
Glad to hear and my pleasure.
Dale JamesTherapistAuthor Commented:
Thank you once again.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Databases

From novice to tech pro — start learning today.