Excel VBA - Анализ общего почтового ящика Outlook - Ошибка времени выполнения 1004: ошибка приложения или объекта - PullRequest
Новая
       17

Excel VBA - Анализ общего почтового ящика Outlook - Ошибка времени выполнения 1004: ошибка приложения или объекта

0 голосов
/ 19 ноября 2018

Я использую следующий код в Excel, чтобы попытаться перенести данные из нашего общего почтового ящика в электронную таблицу для дальнейшего анализа.

Код выдает ошибку времени выполнения 1004: ошибка приложения или объекта в точке, в которой он пытается получить Sender, SenderEmailAddress & SenderName.

Хорошо, когда эти части сделаны неактивными, и он без проблем получает Subject, ReceivedTime и т. Д.

Кто-нибудь знает, что нужно изменить, чтобы это работало?

Кроме того, есть ли у кого-нибудь какие-либо предложения о том, как перебрать все папки в общем почтовом ящике вместо того, чтобы настраивать выбор Case для каждой папки в иерархии почтовых ящиков? Или даже более короткий способ добавления требуемых папок (то есть одна строка кода для каждой папки против 2/3/4 строк)?

Заранее спасибо 

Sub getEmails()

Dim olApp       As Outlook.Application
Dim olNS        As Outlook.Namespace
Dim olFldr      As Outlook.MAPIFolder
Dim olItem      As Object
Dim olMailItem  As Outlook.MailItem
Dim ws          As Worksheet
Dim iRow        As Long
Dim hdr         As Variant
Dim iFldr       As Long
Dim lstAtt      As String
Dim olAtt       As Outlook.Attachment
Dim dlm         As String

Set ws = ThisWorkbook.Worksheets("Sheet1")

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")

With ws
    iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Application.ScreenUpdating = False

For iFldr = 1 To 2
    Select Case iFldr
        Case 1
            Set olFldr = olNS.Folders(1)
            Set olFldr = olFldr.Folders("Inbox")
            'Set olFldr = olFldr.Folders("Access Requests")
            'Set olFldr = olFldr.Folders("Ad-hoc Requests")
        Case 2
            Set olFldr = olNS.Folders(1)
            Set olFldr = olFldr.Folders("Inbox")
            Set olFldr = olFldr.Folders("Folders")
        Case Else
    End Select

    For Each olItem In olFldr.Items
        If olItem.Class = olMail Then
            Set olMailItem = olItem
                iRow = iRow + 1
            With olMailItem
                If Not .Sender Is Nothing Then ws.Cells(iRow, "D") = .Subject
                ws.Cells(iRow, "A") = .Sender
                ws.Cells(iRow, "B") = .SenderEmailAddress
                ws.Cells(iRow, "C") = .SenderName

                ws.Cells(iRow, "E") = .ReceivedTime
                ws.Cells(iRow, "F") = .Categories
                ws.Cells(iRow, "G") = .TaskCompletedDate
                ws.Cells(iRow, "H") = olFldr.Name
                lstAtt = ""
                dlm = ""
                For Each olAtt In .attachments
                    lstAtt = lstAtt & dlm & olAtt.DisplayName
                    dlm = ";" 'Chr(10)
                Next
                ws.Cells(iRow, "I") = lstAtt
            End With
        End If
    Next olItem
Next iFldr


With ws
    hdr = Array("Sender", "SenderEmailAddress", "SenderName", "Subject", "ReceivedTime", "Categories", "TaskCompletedDate", "Folder", "Attachments")
    .Range("A1").Resize(, UBound(hdr)) = hdr
    .Columns.AutoFit
End With

Application.ScreenUpdating = False

MsgBox "Complete!"

End Sub

Locals Window view

Ответы [ 2 ]

0 голосов
/ 19 ноября 2018

MailItem.Sender возвращает объект (AddressEntry), а не скалярное значение (строка или целое число).Вы уже получаете доступ к SenderEmailAddress и SenderName, зачем вам нужен Sender?

Кроме того, вы предполагаете, что первое хранилище всегда является почтовым ящиком по умолчанию.Это не всегда так.Вместо этого используйте Namespace.GetDefaultFolder(olFolderInbox).

0 голосов
/ 19 ноября 2018

Ваша проблема, вероятно, здесь; 

If Not .Sender Is Nothing Then ws.Cells(iRow, "D") = .Subject
ws.Cells(iRow, "A") = .Sender

Если отправитель не является нулевым, вы записываете тему в столбец D. Затем, независимо от того, является ли отправитель нулевым или нет, вы пытаетесь записать отправителя в столбец А. Это приведет к ошибке когда это ноль.

Исправление будет зависеть от того, чего вы пытаетесь достичь. Если вы не хотите выводить какие-либо почтовые сообщения с нулевым отправителем (обычно это черновое или удаленное письмо, которое не было отправлено), просто включите все в проверку If Not .Sender is Nothing. 

With olMailItem
    If Not .Sender Is Nothing Then
        iRow = iRow + 1
        ws.Cells(iRow, "D") = .Subject
        ws.Cells(iRow, "A") = .Sender
        ws.Cells(iRow, "B") = .SenderEmailAddress
        ws.Cells(iRow, "C") = .SenderName

        ws.Cells(iRow, "E") = .ReceivedTime
        ws.Cells(iRow, "F") = .Categories
        ws.Cells(iRow, "G") = .TaskCompletedDate
        ws.Cells(iRow, "H") = olFldr.Name
        lstAtt = ""
        dlm = ""
        For Each olAtt In .Attachments
            lstAtt = lstAtt & dlm & olAtt.DisplayName
            dlm = ";" 'Chr(10)
        Next
        ws.Cells(iRow, "I") = lstAtt
    End If
End With
...