我目前正在开发一个宏来抓取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代码来正确补偿。
奖金问题:有没有办法按名称刮取子文件夹?
答案 0 :(得分:1)
测试TypeOf项目,如果是mailItem则传递它。
If TypeOf olFolder.Items.Item(iRow) Is MailItem Then
Call SaveEmailAttachment(olFolder.Items.Item(iRow))
end if