1

I have a VBA code here that export email addresses of a chosen subfolder to an Excel file. My problem is that, it only works to only one of my folders.

When I try using this macro to other folders, I'm getting a "Run Time Error 13 TYPE MISMATCH" error. I really don't have an idea why I am getting this error. I hope someone could help me detect where the problem came from.

Here's my code:

Sub ExportToExcel()


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.xlsx"
strPath = "C:\Users\Gabriel.Alejandro\Desktop\"
strSheet = strPath & strSheet


Debug.Print strSheet
  'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
  'Handle potential errors with Select Folder dialog box.


  '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  'The part where I am getting the ERROR 

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


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

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
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
alejandraux
  • 13
  • 6
  • Which version of Outlook/Office are you targeting? [Difference between Outlook.Folder and Outlok.MAPIFolder](http://stackoverflow.com/a/12353494/205233) seems to indicate that `Outlook.Namespace`and `Outlook.MAPIFolder` are deprecated. – Filburt Sep 07 '16 at 11:06
  • I am trying to export to Office 2013. This code works to one of my subfolders in outlook but not in the other folders – alejandraux Sep 07 '16 at 11:12
  • The Namespace and MAPIFolder is just for selecting the folders I want to export . I don't think it's the problem – alejandraux Sep 07 '16 at 11:15

1 Answers1

0

You assume every itm is a mailitem.

You could skip an item if it is not a mailitem:

For Each itm In fld.items

    intColumnCounter = 1

    If itm.Class = olMail Then

        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

    Else

        Debug.Print " Item is not a mailitem."

    End If

Next itm

You could instead bypass errors if the item does not have the properties you want.

For Each itm In fld.items

    intColumnCounter = 1

    intRowCounter = intRowCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    On Error Resume Next
    rng.Value = itm.To
    On Error GoTo 0

    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    On Error Resume Next
    rng.Value = itm.senderemailaddress
    On Error GoTo 0

Next itm
niton
  • 8,771
  • 21
  • 32
  • 52