返回我认为是 MailItem 的对象的 MailItem 属性时出现类型不匹配错误答案

【问题标题】：Type mismatch error when returning a MailItem property of an object I assume to be a MailItem返回我认为是 MailItem 的对象的 MailItem 属性时出现类型不匹配错误
【发布时间】：2018-11-23 05:49:54
【问题描述】：

我正在整理 Outlook 的 VBA 代码。我明白了

“运行时错误'13'：类型不匹配

程序是从收件箱邮件中导入主题。它工作正常，但现在Next olItem 出现错误。

Sub PullOutlookData()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim olApp As Outlook.Application, olNs As Outlook.Namespace
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim ws As Worksheet
Dim lRow As Long
Dim vItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")

Set ws = ThisWorkbook.Sheets("OutlookRecord") '<--- relevant worksheet name
Set olItems = olNs.Folders("faizan.farooq@ke.com.pk").Folders("Inbox").Items '<--- RELEVANT FOLDER name
rCount = 1
Sheet14.Range("A1:D2000").Clear
For Each olItem In olItems
    rCount = rCount + 1
    ws.Range("A" & rCount).value = olItem.SenderName
    ws.Range("B" & rCount).value = olItem.Subject
   
Next olItem
ws.UsedRange.WrapText = False

Call SliceDice
Call FlipColumns

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub
Private Sub test()
    Application.OnTime Now + TimeValue("00:01:00"), "PullOutlookData"
End Sub

【问题讨论】：

您在哪一行收到此错误？
下一个 olItem ....
试试Dim olItem As Variant
对象不支持此属性或方法错误发生在行 { ws.Range("A" & rCount).value = olItem.SenderName}
type mismatch error on loop in vba的可能重复

标签： excel vba outlook

【解决方案1】：

代码清理了一下，希望能解决您的问题...

Sub PullOutlookData()
    On Error GoTo ExitSub
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False

    Dim olApp As Outlook.Application: Set olApp = New Outlook.Application
    Dim olNs As Outlook.Namespace: Set olNs = olApp.GetNamespace("MAPI")
    Dim Inbox As Outlook.MAPIFolder: Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Dim olItems As Outlook.Items: Set olItems = Inbox.Items

    Dim olItem As Outlook.MailItem
    Dim ws As Worksheet, vItem As Variant, i As Long, rCount As Long

    Set ws = ThisWorkbook.Sheets("OutlookRecord") '<--- relevant worksheet name

    ws.UsedRange.ClearContents
    'Sheet14.Range("A1:D2000").Clear

    rCount = 2
    For i = 1 To olItems.Count
        Set vItem = Inbox.Items.Item(i)
        DoEvents
        If vItem.Class = olMail Then
            ws.Range("A" & rCount) = vItem.SenderName
            ws.Range("B" & rCount) = vItem.Subject
            rCount = rCount + 1    
        End If
        'If i > 100 Then Exit For
    Next i

    ws.UsedRange.WrapText = False

    'Call SliceDice
    'Call FlipColumns

ExitSub:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    ActiveSheet.DisplayPageBreaks = True

End Sub

【讨论】：