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

Question

我正在尝试将所有电子邮件保存，导致即时文本搜索到硬盘驱动器文件夹中。 下面的代码能够执行搜索，但在选择每封邮件并将其保存为高清时，在选择所有项目行给我一个错误。 代码在 Excel VBA 中;

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

Dim fldrpath As String
fldrpath = "\mydataEMAILS
Check subfolder for messages and exit of none found
txtsearch = "[e-mail], 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 = "[e-mail]"
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 = "\mydataEMAILS"
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