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

现在，该代码将导入从“开始日期”到最后收到的电子邮件的所有电子邮件。

我可能会弄乱订单或类似的东西，但是如果有人可以帮助我，我将不胜感激。

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

在特定时间段内将电子邮件从Outlook导入到Excel

2 个答案: