从Windows文件夹读取的Outlook消息对于某些值是空白的

问题描述

给定一个包含数千个Outlook MSG文件的目录，我想使用Excel读取某些消息元数据并将其映射到工作表。但是，VBA会将某些字段返回为空白，例如Sender。

我希望每封电子邮件有一个附件。我正在尝试：

Sub SaveOlAttachments()

Dim objOL As outlook.application
Set objOL = New outlook.application
Dim fpath As String
Dim outPath As String
Dim writeRow As Long

fpath="some\path"
outPath="some\path"
writeRow = 2

strFile = Dir(fpath & "\" & "*.msg")
do while Len(strFile) > 0
    Set Msg = objOL.Session.OpenSharedItem(fpath & "\" & strFile)
    If Msg.Attachments.Count > 0 Then
         For Each att In Msg.Attachments
             att.SaveAsFile outPath & "\" & att.Filename
             Cells(writeRow,1).Value = Msg.Subject
             Cells(writeRow,2).Value = att.Filename
             Cells(writeRow,3).Value = Msg.SentOn
         Next
    End If
    writeRow = writeRow + 1
    strFile = Dir
Loop

End Sub

但是，当在“本地”窗口中查看Msg时，我获得了SenderEmailAddress，BCC，正文和收件人的空白值。

我知道打开任何一封电子邮件后都会立即出错。

解决方法

事实证明，将文件从网络驱动器复制到Outlook收件箱中的文件夹后，这些值又回到了可以在Outlook中再次看到的位置。

我不是在Excel中制作工作簿，而是在Outlook的VBE中使用以下方法将每封电子邮件中所需的数据映射到可以保存的csv中。

Sub read_drta()

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.folders("[email protected]")
Set objFolder = objFolder.folders("Inbox")
Set objFolder = objFolder.folders("imports")
fpath = "C:\Users\Email_Tasker"

my_csv = fpath & "\data.csv"

Open my_csv For Output As #1

For Each Item In objFolder.Items

    myLine = Item.Subject & "," & Item.SentOn & "," & Item.SenderEmailAddress & "," & Item.Attachments(1).FileName
    Print #1,myLine
Next Item

Close #1
End Sub

“ Item”对象包含Outlook VBA中的所有内容，但奇怪的是，它在Excel中仍将相同的字段保留为空。

excel excel outlook