Question

我需要将标准outlook字段（从/到/ subject / date，包括类别，最重要的是ConversationID）的所有电子邮件提取到Excel / csv中。我使用的是MS Office 2016，不知道Exchange服务器的版本。

我尝试了几种方法在我的邮箱上这样做： 1）通过标准outlook界面导出数据 2）通过标准导出主机将数据导出到MS访问 3）直接从MS Exchange向MS PowerBI提取数据

在所有3个案例中，我都无法获得ConversationID（PowerBI提取有一些ID，但它不是ConversationID）

现在我明白它应该以某种方式通过MAPI提取，但我对这个话题完全不识字。一些搜索建议使用特殊软件，如Transcend，但对于一个用户来说显然太昂贵了:)）

我还发现了VBA代码直接将数据导入Excel，但它对我不起作用： http://www.tek-tips.com/viewthread.cfm?qid=1739523 还发现了这个很好的解释什么是ConversationID - 对于对主题感兴趣的其他人可能会有所帮助： https://www.meridiandiscovery.com/how-to/e-mail-conversation-index-metadata-computer-forensics/

Answer 1

这里有一些示例代码可以帮助您入门，我已经有类似于您的问题。代码已注释，但可以随意提问：）

Option Explicit

Public Sub getEmails()
On Error GoTo errhand:

    'Create outlook objects and select a folder
    Dim outlook     As Object: Set outlook = CreateObject("Outlook.Application")
    Dim ns          As Object: Set ns = outlook.GetNameSpace("MAPI")

    'This option open a new window for you to select which folder you want to work with
    Dim olFolder    As Object: Set olFolder = ns.pickFolder
    Dim emailCount  As Long: emailCount = olFolder.Items.Count
    Dim i           As Long
    Dim myArray     As Variant
    Dim item        As Object

    ReDim myArray(4, (emailCount - 1))

    For i = 1 To emailCount
        Set item = olFolder.Items(i)
        '43 is olMailItem, only consider this type of email message
        'I'm assuming you only want items with a conversationID
        'Change the logic here to suite your specific needs
        If item.Class = 43 And item.ConversationID <> vbNullString Then
            'Using an array to write to excel in one go
            myArray(0, i - 1) = item.Subject
            myArray(1, i - 1) = item.SenderName
            myArray(2, i - 1) = item.To
            myArray(3, i - 1) = item.CreationTime
            myArray(4, i - 1) = item.ConversationID
        End If
    Next

    'Adding headers, then writing the data to excel
    With ActiveSheet
        .Range("A1") = "Subject"
        .Range("B1") = "From"
        .Range("C1") = "To"
        .Range("D1") = "Created"
        .Range("E1") = "ConversationID"
        .Range("A2:E" & (emailCount + 1)).Value = TransposeArray(myArray)
    End With

    Exit Sub

errhand:
    Debug.Print Err.Number, Err.Description
End Sub

'This function is used to bypass the limitation of -
'application.worksheetfunction.transpose
'If you have too much data added to an array you'll get a type mismatch
'Found here - http://bettersolutions.com/vba/arrays/transposing.htm
Public Function TransposeArray(myArray As Variant) As Variant
    Dim X           As Long
    Dim Y           As Long
    Dim Xupper      As Long: Xupper = UBound(myArray, 2)
    Dim Yupper      As Long: Yupper = UBound(myArray, 1)
    Dim tempArray   As Variant

    ReDim tempArray(Xupper, Yupper)

    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = myArray(Y, X)
        Next
    Next

    TransposeArray = tempArray
End Function

使用ConversationID的Mass Export outlook字母

1 个答案: