Question

在Excel中，我使用以下编码从我的收件箱中的子文件夹下载附件，它工作正常但是是否可以从未读的电子邮件中下载附件？

我很感激你能给我的任何建议或帮助。

我认为它可能是如果objItem.unread然后......但我不完全确定如何在我的编码中实现它？

' public objects moved from Userform code module
Public OutlookApp As New Outlook.Application
Public oNameSpace    As Namespace
Public oFldrList     As Outlook.MAPIFolder
Public objItem       As Outlook.MAPIFolder
Public oSubFldrList  As Outlook.MAPIFolder
Public oSubFldritem  As Outlook.MAPIFolder


Sub GetAttachments(Name As String)
       On Error GoTo GetAttachments_err
       Dim MyMail As MailItem
       Dim ns As Namespace
       Dim Inbox As MAPIFolder
       Dim SubFolder As MAPIFolder
       Dim Item As Object
       Dim Atmt As Attachment
       Dim FileName As String
       Dim i As Integer
       Dim olItem As MailItem
       Dim olAtt As Outlook.Attachment

    i = 0
        If oFldrList.Folders.Count = 0 Then
            MsgBox oFldrList.Name & " has no sub folders"
            MsgBox "There are " & oFldrList.Items.Count & " items in folder"
        Else
            Set SubFolder = oFldrList.Folders(Name)
           ' MsgBox SubFolder.Name & " has " & SubFolder.Items.Count & "  items folders"
        End If

        For Each olItem In SubFolder.Items
           ' MsgBox olItem.Subject & vbLf & "has " & olItem.Attachments.Count & " attachements"
            For Each olAtt In olItem.Attachments
Select Case Right(olAtt.FileName, 4)
Case ".xls"
    FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case ".csv"
    FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case ".txt"
    FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case ".mp3"
       FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case ".jpg"
       FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case Else
    Select Case Right(olAtt.FileName, 5)
    Case ".xlsx"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
Case ".alnk"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
      olAtt.SaveAsFile FileName
    i = i + 1
    End Select
End Select
            Next
        Next

    If i > 0 Then
          MsgBox "I found " & i & " attached files." _
             & vbCrLf & "I have saved them on the" & frmdownloadattchmts.TextBox1.Value & " Path." _
             & vbCrLf & vbCrLf & " ", vbInformation, "Download Finished!"
            Unload Me
       Else
          MsgBox "I didn't find any attached files in your mail.", vbInformation, _
          "Finished!"
      End If
GetAttachments_exit:
         Set Atmt = Nothing
         Set Item = Nothing
         Set ns = Nothing
         Exit Sub
GetAttachments_err:
         MsgBox "An unexpected error has occurred." _
            & vbCrLf & "Please note and report the following information." _
            & vbCrLf & "Macro Name: GetAttachments" _
            & vbCrLf & "Error Number: " & Err.Number _
            & vbCrLf & "Error Description: " & Err.Description _
            , vbCritical, "Error!"
         Resume GetAttachments_exit
End Sub

Answer 1

这样的事情应该有用，虽然我不确定Unread是否只是MailItem的属性，所以你可能还需要在尝试之前检查它是什么类型的对象阅读Unread值

Dim fn

For Each olItem In SubFolder.Items
   ' MsgBox olItem.Subject & vbLf & "has " & olItem.Attachments.Count & " attachements"
    If olItem.Unread Then
        For Each olAtt In olItem.Attachments

            fn = olAtt.Filename

            If fn Like "*.xls" Or fn Like "*.csv" Or fn Like "*.txt" Or _
               fn Like "*.mp3" Or fn Like "*.jpg" Or fn Like "*.xlsx" Or _
               fn Like "*.alnk" Then

                    Filename = frmdownloadattchmts.TextBox1.Value & olAtt.Filename
                    olAtt.SaveAsFile Filename
                    i = i + 1

            End If

        Next 'attachment
    End If 'unread
Next

更改代码以下载附件

1 个答案: