打印电子邮件附件答案

【问题标题】：Print email attachment打印电子邮件附件
【发布时间】：2020-09-04 01:21:57
【问题描述】：

我遇到了这段代码，它打印电子邮件。

我正在尝试打印附件。

这也应该仅限于例如由 senttoprint@test.com 发送的电子邮件，或者如果他们有特定主题，例如 WEB ORDER #2345。

Sub PrintEmail()
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim objWordApp As Word.Application
    Dim strTempFolder As String
    Dim strMailDocument As String
    Dim objMailDocument As Word.Document
    Dim strPrinter As String

    Select Case Application.ActiveWindow.Class
        Case olInspector
            Set objItem = ActiveInspector.CurrentItem
        Case olExplorer
            Set objItem = ActiveExplorer.Selection.Item(1)
    End Select
 
    If TypeOf objItem Is MailItem Then
        Set objMail = objItem
 
        Set objWordApp = CreateObject("Word.Application")
        strTempFolder = CStr(Environ("USERPROFILE")) & "\AppData\Local\Temp"
        strMailDocument = strTempFolder & "\" & Format(Now, "yyyymmddssnn") & ".doc"
        objMail.SaveAs strMailDocument, olDoc
 
        Set objMailDocument = objWordApp.Documents.Open(strMailDocument)
        objWordApp.Visible = True
        objMailDocument.Activate
 
        strPrinter = objWordApp.ActivePrinter
        'Change to the name of specific printer
        objWordApp.ActivePrinter = "Specific Printer"
        objWordApp.PrintOut Range:=wdPrintAllDocument, Item:=wdPrintDocumentContent
        objWordApp.ActivePrinter = strPrinter
 
        objMailDocument.Close False
        objWordApp.Quit
        Kill strMailDocument
    End If
End Sub

【问题讨论】：

标签： vba outlook email-attachments

【解决方案1】：

您似乎需要从与您的条件相对应的文件夹中查找项目并且应该打印。使用Items 类的Find/FindNext 或Restrict 方法。 Restrict 方法是使用Find 方法或FindNext 方法迭代集合中特定项的替代方法。如果项目数量很少，Find 或 FindNext 方法比过滤更快。如果集合中有大量项目，则Restrict 方法的速度明显更快，尤其是在大型集合中只需要找到少数项目的情况下。

但如果您需要从多个文件夹中查找项目，我建议您改用 AdvancedSearch 方法：

Public m_SearchComplete As Boolean  

Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)  
    If SearchObject.Tag = "MySearch" Then  
        m_SearchComplete = True  
    End If  
End Sub  

Sub TestSearchForMultipleFolders()  
    Dim Scope As String  
    Dim Filter As String  
    Dim MySearch As Outlook.Search  
    Dim MyTable As Outlook.Table  
    Dim nextRow As Outlook.Row  
    m_SearchComplete = False  
    'Establish scope for multiple folders  
    Scope = "'" & Application.Session.GetDefaultFolder( _  
    olFolderInbox).FolderPath _  
    & "','" & Application.Session.GetDefaultFolder( _  
    olFolderSentMail).FolderPath & "'"  
    'Establish filter  
    If Application.Session.DefaultStore.IsInstantSearchEnabled Then  
        Filter = Chr(34) & "urn:schemas:httpmail:subject" _  
        & Chr(34) & " ci_phrasematch 'Office'"  
    Else  
        Filter = Chr(34) & "urn:schemas:httpmail:subject" _  
        & Chr(34) & " like '%Office%'"  
    End If  
    Set MySearch = Application.AdvancedSearch( _  
    Scope, Filter, True, "MySearch")  
    While m_SearchComplete <> True  
        DoEvents  
    Wend  
    Set MyTable = MySearch.GetTable  
    Do Until MyTable.EndOfTable  
        Set nextRow = MyTable.GetNextRow()  
        Debug.Print nextRow("Subject")  
    Loop  
End Sub

【讨论】：