Список электронных писем в подпапках Outlook второго уровня с помощью Excel VBA - PullRequest
Новая
       15

Список электронных писем в подпапках Outlook второго уровня с помощью Excel VBA

0 голосов
/ 16 января 2019

У меня есть четыре почтовых ящика ABC@123.com, DEF@123.com, GHI@123.com и JKL@123.com.

Приведенная ниже кодировка переходит на мою вкладку с именем refTables, получает список почтовых ящиков. Идет только в эти ящики.

Я хочу также получать письма из всех подпапок.

Примеры имен подпапок: InProgress, Ожидающий ответ и Отправленный тикет. 

Private Function getEmails(emailAddress, folderName, destinationSheet)

'retrieves emails form outlook given address, folder, and destination sheet

Row = 2
For Each Folder In Outlook.Session.Folders
    If Folder.Name = emailAddress Then
        For Each subfolder In Folder.Folders
            If subfolder.Name = folderName Then
                For Each Item In subfolder.Items
                    If TypeName(Item) = "MailItem" And Item.MessageClass <> "IPM.Outlook.Recall" Then
                        Sheets(destinationSheet).Cells(Row, 1) = Item.ReceivedTime
                        Sheets(destinationSheet).Cells(Row, 2) = Round(Now() - Item.ReceivedTime, 0)
                        Sheets(destinationSheet).Cells(Row, 3) = Item.Categories
                        Sheets(destinationSheet).Cells(Row, 4) = Item.SenderName
                        Sheets(destinationSheet).Cells(Row, 5) = Item.Subject
                        Sheets(destinationSheet).Cells(Row, 6) = Item.TaskCompletedDate
                        Sheets(destinationSheet).Cells(Row, 7) = Folder.Name
                        Sheets(destinationSheet).Cells(Row, 8) = Item.LastModificationTime
                        Sheets(destinationSheet).Cells(Row, 9) = Round(Item.TaskCompletedDate - Item.ReceivedTime)
                         Row = Row + 1
                    End If
                Next
            End If
        Next
    End If
Next

End Function
...