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

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:\Users\Desktop\" & 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("abc.xyz@pqr.com").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

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

2 个答案: