VBA Run-time error '13'

Question

I am putting together a VBA macro for Outlook and I am getting a "Run-time error '13': Type mismatch. I am not that experienced with VBA so I could really use some help. I am trying to save my Outlook message subjects and attachment names to a text file. I am getting the error 13 message when it gets to "xlWB.close".

 Option Explicit
 Sub LogToExcel()
 Dim olItem As Outlook.MailItem
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3, vText4, vText5 As Variant
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim mfolder As Folder
 Dim oAtt As Attachment
 Dim strAtt As String
 Dim strMail As String
 Dim selItems As Items

enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Desktop\outlook_log.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

Set mfolder = Application.ActiveExplorer.CurrentFolder

Set selItems = mfolder.Items

For Each olItem In selItems
strAtt = ""
strMail = ""
If olItem.Attachments.Count > 0 Then
For Each oAtt In olItem.Attachments
    strAtt = oAtt.FileName & "; " & strAtt
Next oAtt
Else
    strAtt = "No Attachments"
End If

    'Find the next empty line of the worksheet
     rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
     rCount = rCount + 1

           vText = olItem.SenderName
           vText2 = olItem.ReceivedTime
           vText3 = olItem.Subject
           vText4 = strAtt
           vText5 = mfolder.Name

  xlSheet.Range("B" & rCount) = vText
  xlSheet.Range("c" & rCount) = vText2
  xlSheet.Range("d" & rCount) = vText3
  xlSheet.Range("e" & rCount) = vText4
  xlSheet.Range("f" & rCount) = vText5

Next

xlWB.Close
     If bXStarted Then
         xlApp.Quit
     End If
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub​

Answer 1

13 is Type Mismatch, which is happening because olItem is defined as an Outlook.MailItem, but the mFolder.Items can contain OTHER things in it too (such as Outlook.MeetingItems). A quick change of your code could be:

 Option Explicit
 Sub LogToExcel()
 Dim olItem As Outlook.MailItem
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3, vText4, vText5 As Variant
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim mfolder As Folder
 Dim oAtt As Attachment
 Dim strAtt As String
 Dim strMail As String
 Dim selItems As Items

 Dim vItem


enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Desktop\outlook_log.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

Set mfolder = Application.ActiveExplorer.CurrentFolder

Set selItems = mfolder.Items

For Each vItem In selItems

If TypeOf vItem Is Outlook.MailItem Then
    Set olItem = vItem
    strAtt = ""
    strMail = ""
    If olItem.Attachments.Count > 0 Then
    For Each oAtt In olItem.Attachments
        strAtt = oAtt.FileName & "; " & strAtt
    Next oAtt
    Else
        strAtt = "No Attachments"
    End If

        'Find the next empty line of the worksheet
         rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
         rCount = rCount + 1

               vText = olItem.SenderName
               vText2 = olItem.ReceivedTime
               vText3 = olItem.Subject
               vText4 = strAtt
               vText5 = mfolder.Name

      xlSheet.Range("B" & rCount) = vText
      xlSheet.Range("c" & rCount) = vText2
      xlSheet.Range("d" & rCount) = vText3
      xlSheet.Range("e" & rCount) = vText4
      xlSheet.Range("f" & rCount) = vText5
End If



Next vItem

xlWB.Close
     If bXStarted Then
         xlApp.Quit
     End If
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub