Excel VBA - Analysing Shared Mailbox Outlook - Run time error 1004: Application-defined or object-defined error

Question

I am using the following code in Excel to try to get the details from our shared mailbox into a spreadsheet for further analysis.

The code produces a run-time error 1004: application-defined or object-defined error at the point it reaches trying to get the Sender, SenderEmailAddress & SenderName.

It is fine when these parts are made inactive and it gets the Subject, ReceivedTime, etc without any issue.

Does anyone know what needs to be changed to get that working?

Also, does anyone have any suggestions on how to loop through all of the folders in the shared mailbox instead of having to set-up a Case selection for each folder in the mailbox hierarchy? Or even a shorter way of adding the folders required (i.e. one line of code for each folder vs 2/3/4 lines)?

Thanks in advance

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

Josh Eller Josh Eller · Accepted Answer · 2018-11-19T15:02:06

Your issue is probably here;

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

If the sender is not null, you're writing the subject to column D. Then, regardless of whether the sender is null or not, you're trying to write the sender to column A. That's going to throw an error when it is null.

The fix for it will really depend on what you're trying to achieve. If you don't want to output any mail items with a null sender (these will typically be draft or deleted mail that wasn't sent), just include everything in the If Not .Sender is Nothing check.

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

Excel VBA - Analysing Shared Mailbox Outlook - Run time error 1004: Application-defined or object-defined error

2 Answers