Question

我每天早上都在运行Windows Task Scheduler任务，该任务旨在在Excel文件中运行宏。我的任务没用，因为VBA代码现在给我一个错误。在今天之前，VBA代码已100％正常运行。

我收到“我不曾见过的对象不支持此属性或方法”错误。您能帮我使我的代码重新工作吗？

这是我的VBA代码：

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

Answer 1

Some Items in the Inbox may not be 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

Answer 2

所以我能够解决自己的问题。我不确定为什么我的代码在今天之前能100％工作，但是我做了调整，以便可以在Excel日期和Outlook日期之间使用更兼容的语法。下面是修改后的代码，它们更改了Excel日期格式以匹配Outlooks日期格式。另外，我决定将自己的olItems限制在我的时间范围内，而不是“ IF”条件，然后循环查看我的条件。

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

VBA代码在以前具有100％功能时会出错

2 个答案: