Экспорт данных электронной почты в Excel с фильтрацией по дате и системной электронной почте отправителя - PullRequest
0 голосов
/ 26 апреля 2020

Я пытаюсь получить полученное время, заголовок темы и отправителя из почты Outlook в Excel через Outlook VBA.

Я пытался найти способы фильтрации моего экспорта на основе адреса и даты отправителя электронной почты (сегодня).

Я могу фильтровать экспорт только по имени отправителя, что не подходит для моего случая, так как я пытаюсь отфильтровать электронные письма из системной электронной почты. Имя отправителя зависит от того, кто инициирует электронную почту. Адрес электронной почты один и тот же, независимо от того, кто его инициирует.

Sub ExportEmailsfromSpecificSender()
    Dim objEmails, objSpecificEmails As Outlook.Items
    Dim objItem As Object
    Dim strSpecificSender As String
    Dim strFilter As String
    Dim objExcelApplication As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nRow As Integer
    Dim strFilePath As String

    On Error Resume Next
    'Get the emails from a specific sender
    Set objEmails = Application.Session.GetDefaultFolder(olFolderInbox).Folders("xx").Items
    strSpecificSender = InputBox("Input the name of the specific sender:", "Specify Sender")
    strFilter = "[From] = '" & strSpecificSender & "'"
    Set objSpecificEmails = objEmails.Restrict(strFilter)

    Set objExcelApplication = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApplication.Workbooks.Add

    'Export the specific emails to worksheet
    Set objExcelWorksheet = objExcelWorkbook.Worksheets(1)
    With objExcelWorksheet
         .Cells(1, 1) = "Subject"
         .Cells(1, 2) = "Received"
         .Cells(1, 4) = "Categories"
         .Cells(1, 5) = "Size"
    End With

    nRow = 2
    For Each objItem In objSpecificEmails
        With objExcelWorksheet
             .Name = "From " & strSpecificSender
             .Cells(nRow, 1) = objItem.Subject
             .Cells(nRow, 2) = objItem.ReceivedTime
             .Cells(nRow, 4) = objItem.Categories
             .Cells(nRow, 5) = objItem.Size
        End With
        nRow = nRow + 1
    Next

    'Save the Excel workbook
    strFilePath = "C:\Report\Emails from " & strSpecificSender & ".xlsx"
    objExcelWorkbook.Close True, strFilePath

    'Notify you of the export complete
    MsgBox ("Export Complete!")
End Sub

Я новичок в VBA.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...