使用outlook从特定文件夹获取最新未读邮件

Question

我想从非我发送的特定文件夹下载附件。

我需要从那个文件夹下载最新的未读邮件，并附上今天的日期。

那么我该怎么做呢？

这是我的代码：

 Dim app As Microsoft.Office.Interop.Outlook.Application = Nothing
    Dim ns As Microsoft.Office.Interop.Outlook._NameSpace = Nothing
    Dim inboxFolder As Microsoft.Office.Interop.Outlook.MAPIFolder = Nothing
    Dim subFolder As Microsoft.Office.Interop.Outlook.MAPIFolder = Nothing
    Dim destinationDirectory As String = "C:UnreadMails"
    If Not Directory.Exists(destinationDirectory) Then
        Directory.CreateDirectory(destinationDirectory)
    End If
    Try
        app = New Microsoft.Office.Interop.Outlook.Application()
        ns = app.GetNamespace("MAPI")
        ns.Logon(Nothing, Nothing, False, False)
        inboxFolder = ns.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)
        subFolder = inboxFolder.Folders("UnreadMails") 'folder.Folders[1]; also works
        Console.WriteLine("Folder Name: {0}, EntryId: {1}", subFolder.Name, subFolder.EntryID)
        Console.WriteLine("Num Items: {0}", subFolder.Items.Count.ToString())
        For i As Integer = 1 To subFolder.Items.Count
            Dim item As Microsoft.Office.Interop.Outlook.MailItem = CType(subFolder.Items(i), Microsoft.Office.Interop.Outlook.MailItem)
            Dim filePath As String = Path.Combine(destinationDirectory, item.Attachments(i).FileName)
            item.Attachments(i).SaveAsFile(filePath)
        Next i
    Catch ex As System.Runtime.InteropServices.COMException
        Console.WriteLine(ex.ToString())
    Finally
        ns = Nothing
        app = Nothing
        inboxFolder = Nothing
    End Try

Answer 1

我通过这样做成功了：

Dim app As Microsoft.Office.Interop.Outlook.Application = Nothing
Dim ns As Microsoft.Office.Interop.Outlook._NameSpace = Nothing
Dim inboxFolder As Microsoft.Office.Interop.Outlook.MAPIFolder = Nothing
Dim subFolder As Microsoft.Office.Interop.Outlook.MAPIFolder = Nothing
Dim destinationDirectory As String = Directory.GetCurrentDirectory & "Output"
    If Not Directory.Exists(destinationDirectory) Then
                Directory.CreateDirectory(destinationDirectory)
    End If
    Try
        app = New Microsoft.Office.Interop.Outlook.Application()
        ns = app.GetNamespace("MAPI")
        ns.Logon(Nothing, Nothing, False, False)
        inboxFolder = ns.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)
        subFolder = inboxFolder.Folders("checklist") 'folder.Folders[1]; also works
              Try
                  For Each collectionItem As Object In subFolder.Items
                        Dim newEmail As Outlook.MailItem = TryCast(collectionItem, Outlook.MailItem)
                        If newEmail Is Nothing Then
                            Continue For
                        End If
                        If newEmail.Attachments.Count > 0 Then
                            For i As Integer = 1 To newEmail.Attachments.Count
                                Dim filePath As String = Path.Combine(destinationDirectory, newEmail.Attachments(i).FileName)
                                newEmail.Attachments(i).SaveAsFile(filePath)
                            Next i
                        End If
                    Next collectionItem
                Catch ex As Exception
                    Console.WriteLine(ex)
                End Try
            Catch ex As System.Runtime.InteropServices.COMException
                Console.WriteLine(ex.ToString())
            Finally
                ns = Nothing
                app = Nothing
                inboxFolder = Nothing
      End Try
End Sub

Answer 2

此代码创建包含每个日期的文件夹，并将outlook邮件中的附件保存在outlook收件箱的特定子文件夹中。

Public Sub Extract_Outlook_Email_Attachments()
Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.NameSpace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim outMailItem As Outlook.MailItem
Dim todaysDate As Date, subjectFilter As String
Dim saveInFolder As String
Dim mailDate As Date
Dim tDate As String
todaysDate = Format(Now(), "dd/mm/yyyy")
tDate = Replace(todaysDate, "/", "-")
saveInFolder = "C:" & tDate & "" 'CHANGE FOLDER PATH AS NEEDED
If Len(Dir(saveInFolder, vbDirectory)) = 0 Then
    MkDir saveInFolder
End If

OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Set outApp = New Outlook.Application
    OutlookOpened = True
End If
On Error GoTo 0
If outApp Is Nothing Then
    MsgBox "Cannot start Outlook.", vbExclamation
    Exit Sub
End If
Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders("[e-mail]").Folders("Inbox").Folders("Sub Folder")  'CHANGE FOLDER AS NEEDED
If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olmail Then
            Set outMailItem = outItem
            mailDate = Format(outMailItem.ReceivedTime, "dd/mm/yyyy")
            If todaysDate = mailDate Then
            subjectFilter = outMailItem.Subject & ".csv"
                For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile saveInFolder & subjectFilter
                Next
            End If
        End If
    Next
End If
If OutlookOpened Then outApp.Quit
Set outApp = Nothing
End Sub