类型不匹配Outlook.MAPIFolder和对象（错误13）

Question

我以前从来没有玩过VBA。以下脚本应将Outlook电子邮件中的所有电子邮件详细信息保存到Excel电子表格中。

我在执行Set msg = itm时收到错误13。在休息时间itm的值对应于会议邀请，所以不是您的普通电子邮件。这可能是问题吗？如果是这样，我如何告诉VBA忽略任何不是普通电子邮件的内容？

Sub ExportToExcel() 
On Error GoTo ErrHandler 
Dim appExcel As Excel.Application 
Dim wkb As Excel.Workbook 
Dim wks As Excel.Worksheet 
Dim rng As Excel.Range 
Dim strSheet As String 
Dim strPath As String 
Dim intRowCounter As Integer 
Dim intColumnCounter As Integer 
Dim msg As Outlook.MailItem 
Dim nms As Outlook.NameSpace 
Dim fld As Outlook.MAPIFolder 
Dim itm As Object 
    strSheet = "OutlookItems.xls" 
    strPath = Environ("UserProfile") 
    strSheet = strPath & "\Downloads\" & strSheet 
Debug.Print strSheet 
    'Select export folder 
Set nms = Application.GetNamespace("MAPI") 
Set fld = nms.PickFolder 
    'Handle potential errors with Select Folder dialog box. 
If fld Is Nothing Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
ElseIf fld.DefaultItemType <> olMailItem Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
ElseIf fld.Items.Count = 0 Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
End If 
    'Open and activate Excel workbook. 
Set appExcel = CreateObject("Excel.Application") 
appExcel.Workbooks.Open (strSheet) 
Set wkb = appExcel.ActiveWorkbook 
Set wks = wkb.Sheets(1) 
wks.Activate 
appExcel.Application.Visible = True 
    'Copy field items in mail folder. 
For Each itm In fld.Items 
intColumnCounter = 1 
Set msg = itm 
intRowCounter = intRowCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.To 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.SenderEmailAddress 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.Subject 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.SentOn 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.ReceivedTime 
Next itm 

Set appExcel = Nothing 
Set wkb = Nothing 
Set wks = Nothing 
Set rng = Nothing 
Set msg = Nothing 
Set nms = Nothing 
Set fld = Nothing 
Set itm = Nothing 
Exit Sub 

ErrHandler: If Err.Number = 1004 Then 
    MsgBox strSheet & " doesn't exist", vbOKOnly, _ 
    "Error" 
    ElseIf Err.Number = 13 Then 
    MsgBox Err.Number & ": Type mismatch", vbOKOnly, _ 
    "Error" 
    Else 
    MsgBox Err.Number & "; Description: ", vbOKOnly, _ 
    "Error" 
End If 

Set appExcel = Nothing 
Set wkb = Nothing 
Set wks = Nothing 
Set rng = Nothing 
Set msg = Nothing 
Set nms = Nothing 
Set fld = Nothing 
Set itm = Nothing 
End Sub 

Answer 1

如果你只想处理MailItem对象，检查类属性 - 所有Outlook对象模型对象实现它。对于MailItem物体，将为olMail（= 43）：

If itm.Class = 43 Then 'olMail 
    Set msg = itm 
    ...