Импорт электронной почты из Outlook в Excel за определенный период времени

Question

Мне удалось создать макрос, который импортирует электронные письма из Outlook в Excel, если в теме письма указана конкретная строка.

Однако я также хочу добавить критерий для импорта только электронных писем, полученных между двумя датами, но я не могу найти правильный способ сделать это.

Вот код, который у меня есть:

For Each OutlookMail In IFolder.Items
    If OutlookMail.ReceivedTime >= Range("start_date").Value And OutlookMail.ReceivedTime <= Range("end_date").Value Then
        ar() = Split(OutlookMail.Body, ",")
            If InStr(OutlookMail.Subject, "Exportation of purchase order") > 0 Then
                For Each Item In ar
                    dbf.Range("A2").Offset(i, 0).Value = Split(Split(Item, ":")(0), "-")(0)
                    dbf.Range("A2").Offset(i, 0).Columns.AutoFit
                    i = i + 1
                Next Item
            End If
    End If
Next OutlookMail

В данный момент код импортирует каждое электронное письмо, полученное с «start_date» до последнего полученного электронного письма.

Я, наверное, испортил порядок или что-то в этом роде, но если бы кто-нибудь мог мне помочь, я был бы признателен за это.

Answer 1

Ваш оператор If выглядит нормально, хотя я могу весь день смотреть на код и пропустить какую-то очевидную ошибку.Тем не менее, моя первая мысль будет о том, что дата окончания не то, что вы думаете.Пожалуйста, добавьте следующий код перед циклом For:

  Dim StartDate As Date
  Dim EndDate As Date

  StartDate = Range("start_date").Value
  EndDate =  Range("end_date").Value

  Debug.Print "Date range is " & StartDate & " to " & EndDate
  Debug.Assert False

Выполнение остановится на Debug.Assert False.Является ли диапазон дат, как вы ожидаете?

Answer 2

Ну, я решил попробовать переписать код, структурируя его должным образом, и, наконец, смог заставить его работать как задумано.

Я не знаю, будет ли у кого-то такая же проблема, как у меня в будущем, поэтому я опубликую новый код в качестве ответа.

Sub GetDataFromOutlook()

    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Outlook.Namespace
    Dim IFolder As Outlook.MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ar() As String
    ReDim ar(0 To i)

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set wb = ThisWorkbook
    Set IFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("IMPORTADOS")
    Set ws = wb.Sheets("Sheet1")
    i = 0

    Application.ScreenUpdating = False

    For Each OutlookMail In IFolder.Items
        If InStr(OutlookMail.Subject, "Exportation of purchase order") > 0 Then
            If DateValue(OutlookMail.ReceivedTime) >= DateValue(Range("start_date")) And DateValue(OutlookMail.ReceivedTime) <= DateValue(Range("end_date")) Then
                ar() = Split(OutlookMail.Body, ",")
                For Each Item In ar
                    ws.Range("A2").Offset(i, 0).Value = Split(Split(Item, ":")(0), "-")(0)
                    ws.Range("A2").Offset(i, 0).Columns.AutoFit
                    i = i + 1
                Next Item
            End If
        End If
    Next OutlookMail

    ws.Range("Table1[#All]").RemoveDuplicates Columns:=1, Header:=xlYes
    ws.Columns("A:A").EntireColumn.AutoFit

    Application.ScreenUpdating = True

    Set IFolder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub