Find most recent email from specific address and reply-CodePudding

I am trying to build a button in excel that allows me to do a "reply to all" to the last email from a specific email address (contact). So far I am stuck on even finding the emails from the person.

The below code is supposed to find the emails from "[email protected]" (dummy address for example) but after finding all 19 emails in my inbox, filtering for the address then returns 0 results.

I am using excel 2016 and Outlook 2016.

Private Sub CommandButton2_Click()

Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object

Dim olItems As Object
Dim olItemReply As Object
Dim i As Long

Dim emailStr As String
Dim filter As String

Set olApp = CreateObject("Outlook.Application")

Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Debug.Print "olFldr: " & olFldr

emailStr = "[email protected]" '(email address in Excel spreadsheet)
Debug.Print "emailStr: " & emailStr

Set olItems = olFldr.Items
Debug.Print olItems.Count
'finds all 19 items in my inbox with msgbox(olItems.count)


filter = "[SenderEmailAddress] = '" & emailStr & "'"
Debug.Print filter

Set olItems = olFldr.Items.Restrict(filter)
Debug.Print olItems.Count

'finds 0 items now ??? why....

End subPrivate Sub CommandButton2_Click()

Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object

Dim olItems As Object
Dim olItemReply As Object
Dim i As Long

Dim emailStr As String
Dim filter As String

Set olApp = CreateObject("Outlook.Application")

Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Debug.Print "olFldr: " & olFldr

emailStr = "[email protected]" '(email address in Excel spreadsheet)
Debug.Print "emailStr: " & emailStr

Set olItems = olFldr.Items
Debug.Print olItems.Count
'finds all 19 items in my inbox with msgbox(olItems.count)


filter = "[SenderEmailAddress] = '" & emailStr & "'"
Debug.Print filter

Set olItems = olFldr.Items.Restrict(filter)
Debug.Print olItems.Count

'finds 0 items now ??? why....

End sub

EDIT: The new code below manages to find the emails in the inbox, sort to most recent, and start a reply. However, I would also like to search in the Archive folder, sub folder "clean up"

The suggestion from the comment gives me errors with both these attempts:

Part of the issue was that olNs.GetDefaultFolder(olFolderInbox) doesn't work, only when I use olNs.GetDefaultFolder(6) do I get a step further, but olFldr.Folders seems not to work as a command on olFldr

P.s.: When I loop through my folder names, the name of the Archive folder seems to be "Online Archive - [email protected]", but also using this name I could not get it to work

Ideally, I would like to look in both the main inbox PLUS the Archive-Cleanup folders together to find the most recent email of Address X

Private Sub CommandButton2_Click()

Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object

Dim olItems As Object
Dim olItemReply As Object
Dim i As Long

Dim emailStr As String
Dim filter As String
  
Set olApp = CreateObject("Outlook.Application")

Set olNs = olApp.GetNamespace("MAPI")

Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox

Debug.Print "olFldr: " & olFldr
  
  
emailStr = "[email protected]" '(email address in Excel spreadsheet)
Debug.Print "emailStr: " & emailStr


Set olItems = olFldr.Items
Debug.Print olItems.Count
'finds all 19 items in my inbox with msgbox(olItems.count)
MsgBox (olItems.Count)

filter = "[SenderEmailAddress] = """ & emailStr & """"
Debug.Print filter

Set olItems = olFldr.Items.Restrict(filter)
Debug.Print olItems.Count

olItems.Sort "[ReceivedTime]", True

For i = 1 To olItems.Count
    Debug.Print olItems(i).ReceivedTime
    If olItems(i).Class = 43 Then
        Set olItemReply = olItems(i).Reply
        olItemReply.Display
        Exit For
    End If
Next

End Sub

Edit 2: after modifying the code a bit, and selecting the Microsoft Outlook 16.0 Library in the vba Tools -> References I got a step further, but still can't find the right folder. The olNs.Folders now exists, and gives me folder names when I print it out, but how to get to the archive is still elusive to me:

Private Sub CommandButton2_Click()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As Object
Dim olItems As Object
Dim olItemReply As Object
Dim objMail As Object
Dim i As Long

Dim emailStr As String
Dim filter As String
  
Set olApp = CreateObject("Outlook.Application")

Set olNs = olApp.GetNamespace("MAPI")

Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox

CurrentRow = ActiveCell.Row

Debug.Print "olFldr: " & olFldr
  
    EmailCol = FindColumn("E-Mail Address", 2) 'find Col

    emailStr = Cells(CurrentRow, EmailCol)

Debug.Print "emailStr: " & emailStr


Set olItems = olFldr.Items
Debug.Print olItems.Count

Dim olArchive As Outlook.Folder
Dim olCleanUp As Outlook.Folder


For Each myobject In olNs.Folders
    MsgBox (myobject)
    Next
    

Set olArchive = olNs.Folders("Archive")
'.... rest as code same as before....
end sub

CodePudding user response：

A working filter variant should be the next one:

filter = "[SenderEmailAddress] = """ & emailStr & """".

Email account name should be placed between double quotes

In order to search in a different folder than InBox and this one is a subfolder of InBox, having at least a subfolder named "MyFolder", please proceed in the next way:

Set olFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Archive").Folders("MyFolder")

If "Archive" is not a "InBox" subfloder and it is a root folder, please try:

Dim olArchive As Outlook.Folder, olCleanUp as Outlook.Folder
Set olArchive = olNs.folders(olNs.CurrentUser.Address).folders("Archive")
set olCleanUp = olArchive.Folders("Cleanup")

Thanks to the discussion, we found the error (OPs mistake). The working line needed is

Set olNs = olApp.GetNamespace("MAPI")
Dim olCleanUp As Outlook.Folder
'Set olCleanUp = olNs.Folders("[email protected]").Folders("Archive").Folders("Cleanup")