在 Outlook 子文件夹中查找特定电子邮件主题并从电子邮件中下载附件答案

【问题标题】：Finding specific email Subject in Outlook sub folder and download attached files from the email在 Outlook 子文件夹中查找特定电子邮件主题并从电子邮件中下载附件
【发布时间】：2022-11-24 07:12:47
【问题描述】：

我设法制作了从 Outlook 中的收件箱子文件夹下载附件文件的宏，但似乎我无法使其适用于电子邮件主题中的特定符号组合。我只需要从主题名称中包含“906”的电子邮件中下载附件。有人可以为我做这个任务需要的修改吗？我已经陷入了我的代码中：

Sub SaveMail()

SaveEmailAttachmentsToFolder "Meteologica SA Power Forecast", "csv", ""

End Sub
Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                             ExtString As String, DestFolder As String)
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim item As Object
Dim Att As Attachment
Dim FileName As String
Dim MyDocPath As String
Dim I As Integer
Dim wsh As Object
Dim fs As Object
Dim strAttachmentName As String

On Error GoTo ThisMacro_err

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

I = 0
' Check subfolder for messages and exit of none found
If SubFolder.Items.Count = 0 Then
    MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _
           vbInformation, "Nothing Found"
    Set SubFolder = Nothing
    Set Inbox = Nothing
    Set ns = Nothing
    Exit Sub
End If


For Each item In SubFolder.Items
    For Each Att In item.Attachments
        If LCase(Right(Att.FileName, Len(ExtString))) = LCase(ExtString) And InStr(strAttachmentName, "906") > 0 Then
            DestFolder = "C:\Users\Confi-005\OneDrive - confi.com\Desktop\Schedule\Mail_Temp\Download\"
            FileName = DestFolder & item.SenderName & " " & Att.FileName
            Att.SaveAsFile FileName
            I = I + 1
        End If
    Next Att
Next item

If I > 0 Then
    MsgBox "You can find the files here : " _
         & DestFolder, vbInformation, "Finished!"
Else
    MsgBox "No attached files in your mail.", vbInformation, "Finished!"
End If


ThisMacro_exit:
Set SubFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
Set fs = Nothing
Set wsh = Nothing
Exit Sub


ThisMacro_err:
MsgBox "An unexpected error has occurred." _
     & vbCrLf & "Please note and report the following information." _
     & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
     & vbCrLf & "Error Number: " & Err.Number _
     & vbCrLf & "Error Description: " & Err.Description _
     , vbCritical, "Error!"
Resume ThisMacro_exit

End Sub

【问题讨论】：

您可能会在另一个问题上找到以下答案，该问题从已选择的电子邮件中下载附件。您只需在 Outlook 中搜索“906”，选择您想要附件的电子邮件，然后触发宏。 *.com/a/68652604/3688861
没有strAttachmentName。您可以将Att.FileName赋值给strAttachmentName或直接申请And InStr(Att.FileName, "906") > 0

标签： vba email outlook filtering email-attachments

【解决方案1】：

遍历文件夹中的所有项目并不是一个好主意：

For Each item In SubFolder.Items
    For Each Att In item.Attachments

相反，您需要使用 Items 类的 Find/FindNext 或 Restrict 方法，您只能处理符合指定搜索条件的项目。您可能会在我为技术博客撰写的文章中找到对这些方法的深入描述：

例如，您可以使用以下搜索条件在 Subject 行中查找具有特定短语的项目：

criteria = "@SQL=" & Chr(34) _ 
& "urn:schemas:httpmail:subject" & Chr(34) _ 
& " ci_phrasematch 'question'"

在 Filtering Items Using a String Comparison 文章中阅读更多相关信息。

【讨论】：