使用VBA刮取Outlook电子邮件 - 类型不匹配

时间:2018-04-24 20:33:50

标签: excel vba outlook outlook-vba

我目前正在开发一个宏来抓取Outlook电子邮件和附件。有一个次要的类型不匹配错误,希望有人可以指出我需要的数据类型。

所以我知道在某些方面我需要面对一个很大的实际障碍。现在我专注于让事情有效,然后优化

    Sub FetchEmailData()

Dim appOutlook As Object
Dim olNs As Object
Dim olFolder As Object
Dim olItem As Object
Dim iRow As Integer

' Get/create Outlook Application
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
    Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olNs = appOutlook.GetNamespace("MAPI")
Set olFolder = olNs.GetDefaultFolder(6) ' 6 == Inbox for some reason


For iRow = 1 To olFolder.Items.Count

    'Check if we care about the e-mail
    Call SaveEmailAttachment(olFolder.Items.Item(iRow))
    'Go onto the next one if we don't

    'ThisWorkbook.Sheets("Test").Cells(iRow + 1, 1) = olFolder.Items.Item(iRow).SenderEmailAddress
    'ThisWorkbook.Sheets("Test").Cells(iRow + 1, 2) = olFolder.Items.Item(iRow).Subject
    'ThisWorkbook.Sheets("Test").Cells(iRow + 1, 3) = olFolder.Items.Item(iRow).To
    'ThisWorkbook.Sheets("Test").Cells(iRow + 1, 3) = olFolder.Items.Item(iRow).Size



Next iRow

End Sub



Sub SaveEmailAttachment(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
 Dim dateFormat As String

        saveFolder = ThisWorkbook.Names("EmailAttachmentSavePath").RefersToRange.Value2
        dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next

End Sub

所以数据类型不匹配是因为我发送了一个outlook文件夹项,但接收宏期待一个outlook mailitem。我知道我需要将它们都放到相同的项目类型中,可能是通过昏暗的,但我不太确定哪个更好用,以及我需要如何调整saveemailattachment代码来正确补偿。

奖金问题:有没有办法按名称刮取子文件夹?

1 个答案:

答案 0 :(得分:1)

测试TypeOf项目,如果是mailItem则传递它。

If TypeOf olFolder.Items.Item(iRow) Is MailItem Then
    Call SaveEmailAttachment(olFolder.Items.Item(iRow))
end if