0

我想从不是我发送的特定文件夹中下载附件。

我需要从该文件夹中下载今天日期的最新未读邮件。

那么我该怎么做呢？

这是我的代码：

 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
4

2 回答 2

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
于 2013-08-16T10:24:49.230 回答
0

此代码使用每个日期创建文件夹，并将 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("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
于 2018-04-26T10:06:05.390 回答