从特定地址查找最近的电子邮件并回复

Question

我正在尝试在 excel 中构建一个按钮，允许我对来自特定电子邮件地址（联系人）的最后一封电子邮件进行“全部回复”。到目前为止，我什至无法找到此人的电子邮件。

下面的代码应该找到来自“somebody@gmail.com”（例如虚拟地址）的电子邮件，但是在我的收件箱中找到所有 19 封电子邮件后，过滤地址然后 returns 0 个结果。

我正在使用 excel 2016 和 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 = "sombody@gmail.com" '(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 = "sombody@gmail.com" '(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

编辑：下面的新代码设法在收件箱中找到电子邮件，排序到最近，并开始回复。不过，我也想在存档文件夹中搜索，子文件夹“清理”

评论中的建议让我在这两种尝试中都出错了：

部分问题是 olNs.GetDefaultFolder(olFolderInbox) 不起作用，只有当我使用 olNs.GetDefaultFolder(6) 时我才能更进一步，但是 olFldr.Folders 似乎不能作为 olFldr

上的命令

P.s.: 当我遍历文件夹名称时，Archive 文件夹的名称似乎是“Online Archive - myemail@someemail.com”，但也无法使用这个名称开始工作

理想情况下，我想同时查看主收件箱和 Archive-Cleanup 文件夹，以查找地址 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 = "Evelyne.Dewulf@apb.be" '(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

编辑 2：稍微修改一下代码，然后在 vba Tools -> References 中选择 Microsoft Outlook 16.0 Library 我更进一步了，但仍然找不到正确的文件夹。 olNs.Folders 现在存在，并且在我打印出来时给了我文件夹名称，但我仍然难以理解如何到达存档：

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

Answer 1

工作过滤器变体应该是下一个：

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

电子邮件帐户名应放在双引号之间

为了在不同于 InBox 的文件夹中进行搜索，而这个文件夹是 InBox 的子文件夹，至少有一个名为“MyFolder”的子文件夹, 请按以下方式进行:

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

如果“存档”不是“收件箱”子文件夹，而是根文件夹，请尝试：

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

感谢讨论，我们发现了错误（OPs错误）。需要的工作线是

Set olNs = olApp.GetNamespace("MAPI")
Dim olCleanUp As Outlook.Folder
'Set olCleanUp = olNs.Folders("myemail@something.com").Folders("Archive").Folders("Cleanup")

从特定地址查找最近的电子邮件并回复

Find most recent email from specific address and reply

excel

outlook

vba