Question

这是上一个问题（VBA to save attachments (based on defined criteria) from an email with multiple accounts）

的后续跟进

场景：我有一个代码可以遍历某个Outlook帐户中的所有电子邮件，并将附件保存到选定的文件夹中。以前，我的问题是选择从哪里提取附件的文件夹（和帐户）（这是通过上一个问题的建议解决的。）

问题1：代码在行中显示“类型不匹配”错误：

Set olMailItem = olFolder.Items(i)

问题2：如问题标题所述，我的主要目标是遍历所有附件并仅保存那些具有给定条件的附件（excel文件，其中一个页面名称为“ASK”和一个名为“BID”）。不仅仅是简单如果要考虑这些标准，我必须将所有文件下载到“临时文件夹”，选择并将最终生成的文件放在输出文件夹中，或者将所有文件下载到最终文件夹并删除那些文件不符合标准。

问题：我似乎无法找到执行这两项操作的方法。

问题：如何做到这一点？那两个中的哪一个会更有效率？

代码：

Sub email()

Application.ScreenUpdating = False

Dim olApp As New Outlook.Application
Dim olNameSpace As Object
Dim olMailItem As Outlook.MailItem
Dim olFolder As Object
Dim olFolderName As String
Dim olAtt As Outlook.Attachments
Dim strName As String
Dim sPath As String
Dim i As Long
Dim j As Integer
Dim olSubject As String
Dim olSender As String
Dim sh As Worksheet
Dim LastRow As Integer

'delete content except from row 1
ThisWorkbook.Worksheets("FileNames").Rows(2 & ":" & ThisWorkbook.Worksheets("FileNames").Rows.count).Delete

'set foldername and subject
olFolderName = ThisWorkbook.Worksheets("Control").Range("D10")
'olSubject = ThisWorkbook.Worksheets("Control").Range("D16")
olSender = ThisWorkbook.Worksheets("Control").Range("D16")

sPath = Application.FileDialog(msoFileDialogFolderPicker).Show
sPathstr = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

Set olNameSpace = olApp.GetNamespace("MAPI")

'check if folder is subfolder or not and choose olFolder accordingly
'Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Folders(olFolderName)
Set olFolder = olNameSpace.Folders("email@email.com").Folders("Inbox")

If (olFolder = "") Then
    Set olFolder = olNameSpace.Folders("email@email.com").Folders("Inbox")
End If

'loop through mails
h = 2
For i = 1 To olFolder.Items.count
    Set olMailItem = olFolder.Items(i)

    'check if the search name is in the email subject
    'If (InStr(1, olMailItem.Subject, olSubject, vbTextCompare) <> 0) Then
    If (InStr(1, olMailItem.Sender, olSender, vbTextCompare) <> 0) Then

        With olMailItem

                strName = .Attachments.Item(j).DisplayName

                'check if file already exists
                If Not Dir(sPathstr & "\" & strName) = "" Then
                .Attachments(j).SaveAsFile sPathstr & "\" & "(1)" & strName
                ThisWorkbook.Worksheets("FileNames").Range("A" & h) = "(1)" & strName
                Else
                .Attachments(j).SaveAsFile sPathstr & "\" & strName
                ThisWorkbook.Worksheets("FileNames").Range("A" & h) = strName
                End If

                h = h + 1
            Next

        End With

    End If
Next 

Application.ScreenUpdating = True
MsgBox "Download complete!", vbInformation + vbOKOnly, "Done"

End Sub

Answer 1

问题1：

您的文件夹中可能有会议邀请或常规邮件以外的其他内容查看Class的{{1}}媒体资源，看看它是Item

问题2：

我将使用错误处理，这里：

使用适当的名称保存在临时文件夹中
打开文件
尝试登录表
如果出现错误，请关闭文件
如果没有错误，请将文件保存在目标文件夹

完整代码：

olMail

VBA循环通过电子邮件附件并根据给定的标准进行保存

1 个答案:

问题1：

问题2：