ReceivedTime объекта Outlook в папке «Входящие» выдает ошибку «Объект не поддерживает это свойство или метод» - PullRequest
Новая
       15

ReceivedTime объекта Outlook в папке «Входящие» выдает ошибку «Объект не поддерживает это свойство или метод»

0 голосов
/ 09 мая 2019

Каждое утро я запускал задачу планировщика заданий Windows для запуска макроса в файле Excel.Моя задача не сработала, потому что код VBA теперь выдает ошибку.Код VBA до сегодняшнего дня был на 100% функциональным.

Я получаю

"Объект не поддерживает это свойство или метод" 

Dim olApp As Object
Dim olNS As Object
Dim myDate As Date
Dim olItems As Object
Dim olItem As Object
Dim olAttach As Object
Dim Date1 As String
Dim Date2 As String
Dim iAttachments As Integer

Date1 = Date & " " & TimeValue("6:00:00")
Date2 = Date & " " & TimeValue("00:00:00")

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If

Set olNS = olApp.GetNamespace("MAPI")

Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items

For Each olItem In olItems

    If olItem.ReceivedTime < Date1 Then  '<----- ERROR LINE
        If olItem.ReceivedTime > Date2 Then
            If InStr(olItem.Body, "Darth Vader") > 0 Then

                iAttachments = olItem.Attachments.Count + iAttachments

                Set olAttach = olItem.Attachments.Item(1)

                On Error GoTo Err_Handler
                olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

                Set olAttach = Nothing
                Set olItem = Nothing

                If iAttachments = 4 Then Exit For
            End If
        End If
    End If
Next

    Set olAttach = Nothing
    Set olItem = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
    Set olItems = Nothing

Exit Sub

Ответы [ 2 ]

3 голосов
/ 09 мая 2019

Некоторые элементы в папке «Входящие» могут не иметь значения MailItems или иным образом не иметь свойства ReceivedTime. Поскольку вас интересует только тип MailItem, вы можете использовать следующую условную проверку в вашем For Each: 

For Each olItem In olItems
    'With early binding, you could use:
    ' If TypeOf olItem Is MailItem Then 
    'Otherwise:
    If TypeName(olItem) = "MailItem" Then
        If olItem.ReceivedTime < Date1 Then  ' <----- ERROR LINE
        If olItem.ReceivedTime > Date2 Then
        If InStr(olItem.Body, "Darth Vader") > 0 Then

        iAttachments = olItem.Attachments.Count + iAttachments

        Set olAttach = olItem.Attachments.Item(1)

        On Error GoTo Err_Handler
        olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

        Set olAttach = Nothing
        Set olItem = Nothing


        If iAttachments = 4 Then Exit For
        End If
        End If
    End If
Next
0 голосов
/ 09 мая 2019

Итак, я смог решить свой вопрос.Я не уверен, почему мой код работал на 100% до сегодняшнего дня, но я сделал настройку, чтобы у меня был более совместимый синтаксис между датами Excel и датами Outlook.Ниже мой модифицированный код, который изменяет мой формат даты Excel, чтобы соответствовать форматам даты Outlook.Кроме того, вместо условий «ЕСЛИ» я решил ограничить свои olItems в пределах своего временного интервала и затем выполнить цикл для моих условий. 

Dim olApp As Object
Dim olNS As Object
Dim myDate As Date
Dim olItems As Object
Dim olItem As Object
Dim olAttach As Object
Dim Date1 As String
Dim Date2 As String
Dim iAttachments As Integer

Date1 = Date & " " & TimeValue("6:00:00 am")
Date11 = Format(Date1, "ddddd h:nn AMPM")     <----- Date to match Outlook format
Date2 = Date & " " & TimeValue("00:00:00 am")
Date22 = Format(Date2, "ddddd h:nn AMPM")     <----- Date to match Outlook format


On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If

Set olNS = olApp.GetNamespace("MAPI")



Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items.Restrict("[ReceivedTime] > """ & Date22 & """ and [ReceivedTime] < """ & Date11 & """")     <----- Restricted my olItems to my specific range



For Each olItem In olItems
    If InStr(olItem.Body, "Darth Vader") > 0 Then

    iAttachments = olItem.Attachments.Count + iAttachments

    Set olAttach = olItem.Attachments.Item(1)

    On Error GoTo Err_Handler
    olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.Filename

    Set olAttach = Nothing
    Set olItem = Nothing


    If iAttachments = 4 Then Exit For

    End If
Next


    Set olAttach = Nothing
    Set olItem = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
    Set olItems = Nothing



Exit Sub
...