Question

我正在Excel中使用以下代码来尝试从共享邮箱中获取详细信息到电子表格中以进行进一步分析。

代码会产生运行时错误1004：在尝试获取Sender，SenderEmailAddress和SenderName时到达应用程序定义或对象定义的错误。

将这些部分设置为非活动状态并获取Subject，ReceivedTime等没有任何问题是很好的选择。

有人知道需要做些什么才能使它正常工作吗？

此外，对于如何遍历共享邮箱中的所有文件夹，而不必为邮箱层次结构中的每个文件夹设置案例选择，是否有人有任何建议？甚至是添加所需文件夹的更短方法（即，每个文件夹的一行代码与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!"

结束子

Answer 1

您的问题可能在这里；

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

如果发件人不为null，则将主题写到D列。然后，无论发件人是否为null，都将尝试将发件人写到A列。这将引发错误当它为空时。

此修复程序实际上取决于您要实现的目标。如果您不想输出任何带有空发件人的邮件（这些邮件通常是未发送的草稿或已删除的邮件），则只需在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

Answer 2

MailItem.Sender返回一个对象（AddressEntry），而不是标量值（字符串或整数）。您已经在访问SenderEmailAddress和SenderName，为什么需要发件人？

此外，您假设第一个存储始终是默认邮箱。并非总是如此。请改用Namespace.GetDefaultFolder(olFolderInbox)。

Excel VBA-分析共享邮箱Outlook-运行时错误1004：应用程序定义或对象定义的错误

2 个答案: