如何将Outlook即时搜索结果电子邮件保存在硬盘文件夹中

Question

我试图将所有电子邮件（由于即时文本搜索而导致的结果）保存到硬盘文件夹中。 下面的代码能够执行搜索，但是在选择每封邮件并将其保存为HD时，在selectallitems行出现了错误。 代码在excel vba中；

Dim OlApp As Outlook.Application
Set OlApp = CreateObject("Outlook.Application")


Dim fldrpath As String
fldrpath = "\\mydata\EMAILS\

Check subfolder for messages and exit of none found
txtsearch = "abc@xyz.com, received:4/1/2017..4/30/2017"
OlApp.ActiveExplorer.Search txtsearch, olSearchScopeAllFolders

Dim myitem As Outlook.MailItem
Dim objitem As Object
Set myitem = OlApp.ActiveExplorer.SelectAllItems
Set objitem = myitem
objitem.SaveAs fldrpath & "test" & ".msg", olMSG

任何其他保存电子邮件的替代代码也将不胜感激。 提前致谢 ！！ 寻找快速解决方案

Answer 1

保存搜索结果似乎更容易以其他方式实现。

从Outlook，而不是Excel。

Sub SearchForStr_Save()

    Dim strSearch As String
    Dim strDASLFilter As String
    Dim strScope As String

    Dim objItem As Object

    Dim objSearch As search
    Dim srchFolder As folder
    Dim fldrpath As String

    strSearch = "abc@xyz.com"
    strDASLFilter = "urn:schemas:httpmail:textdescription LIKE '%" & strSearch & "%'"

    strScope = "'Inbox'"

    Set objSearch = AdvancedSearch(Scope:=strScope, filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")

    Set srchFolder = objSearch.Save(strSearch)

    'fldrpath = "\\mydata\EMAILS\"
    fldrpath = "h:\test\"

    For Each objItem In srchFolder.Items
        'Debug.Print objItem.subject
        If objItem.Class = olMail Then
            objItem.SaveAs fldrpath & "test" & ".msg", olMsg
        End If
    Next

ExitRoutine:
    Set objSearch = Nothing
    Set srchFolder = Nothing

End Sub