VBA в Outlook - подсчет писем по дате + циклические подпапки - PullRequest
0 голосов
/ 14 марта 2019

Начинающий здесь

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

Когда я пытаюсь запустить его, я могу выбрать папку, но я получаю ошибку «438» во время выполнения: «Объект не поддерживает это свойство или метод» в строке после цикла «для», но я не могу » не знаю почему.

Это строка, в которой отладчик сообщает мне, что произошла ошибка:

receive_datetime = objCurrentFolder.Items(i).SentOn

Это весь макрос:

 Sub CountItems()
    Dim lItemsCount As Long

    StartDate = DateSerial(2018, 1, 1)
    EndDate = DateSerial(2020, 1, 1)

    'Select a folder
    Set objMainFolder = Outlook.Application.Session.PickFolder

    If objMainFolder Is Nothing Then
       MsgBox "You choose select a valid folder!", vbExclamation + vbOKOnly, "Warning for Pick Folder"
    Else
       'Initialize the total count
       lItemsCount = 0
       Call LoopFolders(objMainFolder, lItemsCount)
    End If

    'Display a message for the total count
    MsgBox "There are " & lItemsCount & " items in the " & objMainFolder.Name & " folder Including its subfolders.", vbInformation, "Count Items"
End Sub

Sub LoopFolders(ByVal objCurrentFolder As Outlook.Folder, lCurrentItemsCount As Long)
    Dim objSubfolder As Outlook.Folder
    Set receiveditems = objCurrentFolder.Items

    For i = receiveditems.Count To 1 Step -1 ' the last item in the collection is your most recent email. This can be handy to know if your inbox is massive and you want to include a Exit For at some point, e.g. when you run into a date < StartDate
        receive_datetime = objCurrentFolder.Items(i).SentOn
        If receive_datetime >= StartDate And receive_datetime <= EndDate Then
            lCurrentItemsCount = lCurrentItemsCount + 1
        End If
    Next i

    'Process all folders and subfolders recursively
    If objCurrentFolder.Folders.Count Then
       For Each objSubfolder In objCurrentFolder.Folders
           Call LoopFolders(objSubfolder, lCurrentItemsCount)
       Next
    End If
End Sub

Я надеюсь, что кто-нибудь может мне помочь. =)

1 Ответ

0 голосов
/ 15 марта 2019

Благодаря Тиму Уильямсу , помогавшему мне.Я думаю, что заставил его работать, проверив, является ли это MailItem или нет.

 Select Case True
        Case TypeOf objCurrentFolder.Items(i) Is Outlook.MailItem
            receive_datetime = objCurrentFolder.Items(i).SentOn
            If receive_datetime >= StartDate And receive_datetime <= EndDate Then
                lCurrentItemsCount = lCurrentItemsCount + 1
            End If
        Case Else
             lCurrentItemsCount = lCurrentItemsCount + 0
    End Select
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...