Question

我正在尝试将所有电子邮件保存到硬盘驱动器文件夹中。下面的代码能够执行搜索，但在selectallitems行中给我一个错误，同时选择每个邮件并将它们保存为HD。代码在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

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

1 个答案: