Outlook VBA Runtime error 13 Type mis match

Sub test()

Dim arrFolderNames As Variant
Dim myfolder As Variant
Dim strFolder As Variant
Dim fldr As Object
Dim strFilter As String
Dim lngItemCount As Long
Dim lngFolderCount As Long
Dim olMailItems As Object
Dim varNow As Variant
Dim varChoice As Variant
Dim strFilterLastHour As String
Dim strFilterToday As String
Dim strFilterYesterday As String
Dim strFilterCustomMonth As String
Dim customDate As Date
Dim dhDaysInMonth As String
Dim boolupdate As Boolean
Dim arrCounts() As Long
Dim str As String
    
    strFilter = ""
    varNow = Now()
    strFilterLastHour = "[received] >= '" & Format(DateAdd("h", -1, varNow), "ddddd h:nn AMPM") & "'" & " and " & "[received] <= '" & Format(varNow, "ddddd h:nn AMPM") & "'"
    strFilterToday = "[Received] >= '" & Format(Date + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[Received] < '" & Format(DateAdd("d", 1, varNow) + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"
    strFilterYesterday = "[Received] >= '" & Format(DateAdd("d", -1, Date) + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[Received] < '" & Format(Date + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"

     varChoice = ""
    boolupdate = True
    Do While boolupdate
        varChoice = InputBox("Select number for appropriate choice" & vbCrLf & vbCrLf & _
            "1. Mails in the last Hour." & vbCrLf & _
            "2. Mails Today" & vbCrLf & _
            "3. Mails Yesterday" & vbCrLf & _
            "4. Mails Month" & vbCrLf & _
            "5. Exit without doing anything" _
            , "Select mail scope")
        If Not IsNumeric(varChoice) Then
            boolupdate = True
        ElseIf varChoice < 1 Or varChoice > 5 Then
            boolupdate = True
        Else
            boolupdate = False
            Select Case varChoice
                Case 1
                    strFilter = strFilterLastHour
                Case 2
                    strFilter = strFilterToday
                Case 3
                    strFilter = strFilterYesterday
                Case 4
                tempVar = InputBox("Please enter the first day of the specific month." & vbCrLf & "E.g. February - '1/2/14'")
                 If tempVar <> "" Then customMonth = CDate(tempVar) Else Exit Sub
    
                 dhDaysInMonth = (DateSerial(Year(customMonth), Month(customMonth) + 1, 1) - DateSerial(Year(customMonth), Month(customMonth), 1))
                  customMonthEnd = Right(customMonth, Len(customMonth) - InStr(customMonth, "/"))
                 customMonthEnd = CDate(dhDaysInMonth & "/" & customMonthEnd)
              strFilterCustomMonth = "[Received] >= '" & Format(customMonth + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[Received] < '" & Format(customMonthEnd + TimeSerial(24, 0, 0), "ddddd h:nn AMPM") & "'"
                    
            strFilter = strFilterCustomMonth
                 
                Case 5
                    Exit Sub
            End Select
        End If
    Loop
    If varChoice <> 5 Then
        varNow = Now
        'arrFolderNames = Array("\\R.1@bfc.com\Inbox", "\\Mailbox - REVS\Inbox\Archive\2011\Sep 11")
        'arrFolderNames = Array("\\rest@ppc.com\Inbox")
        arrFolderName = RetEmailFolders
     '   MsgBox arrCounts
  
        ReDim arrCounts(LBound(arrFolderNames) To UBound(arrFolderNames))
        lngItemCount = 0
        For Each strFolder In arrFolderNames
            Set fldr = olNav2Folder(CStr(strFolder), False)
            If Not fldr Is Nothing Then
                With fldr
                    Set olMailItems = fldr.Items.Restrict(strFilter)
                    arrCounts(lngFolderCount) = olMailItems.Count
                    lngFolderCount = lngFolderCount + 1
                    lngItemCount = lngItemCount + olMailItems.Count
                End With
                Else 'new added
                lngFolderCount = lngFolderCount + 1 ' new added
            End If
        Next
        For lngFolderCount = LBound(arrFolderNames) To UBound(arrFolderNames)
            str = str & arrFolderNames(lngFolderCount) & " :> " & arrCounts(lngFolderCount) & vbCrLf
        Next
        str = str & vbCrLf & "Grand Total of  :> " & lngItemCount
        'MsgBox str
    End If
    
'Excel output

Dim xlapp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim xlRange As Object
Dim intRow As Integer

    Set xlapp = CreateObject("excel.application")
    Set xlWB = xlapp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    Set xlRange = xlWS.Range("a1")
    For lngFolderCount = LBound(arrFolderNames) To UBound(arrFolderNames)
        xlRange.Offset(lngFolderCount) = arrFolderNames(lngFolderCount)
        xlRange.Offset(lngFolderCount, 1) = arrCounts(lngFolderCount)
    Next
    xlWS.Range("a1:B1").EntireColumn.AutoFit
    xlapp.Visible = True
Set olMailItems = Nothing
Set myfolder = Nothing
 
End Sub

Public Function olNav2Folder(foldername As String, Optional CheckOnly As Boolean) As Object
Dim olApp As Object
Dim olNs As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer

    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNs.Folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.Folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If CheckOnly Then
                    Set reqdFolder = Nothing
                    Exit For
                Else
                    reqdFolder.Folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.Folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                End If
            End If
        Else
        End If
    Next
    Set olNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNs = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function


Public Function RetEmailFolders() As Variant
     

        Const strFileName As String = "z:\Caraffice\Test\emailFolders.txt"
    Dim readArray() As String
    Dim intFileNum As Integer
    Dim intCount As Integer
    Dim strRecordData As String
     
    intFileNum = FreeFile
    intCount = 0
    
        Open strFileName For Input As #intFileNum
 
       
    Do Until EOF(intFileNum)
        ReDim Preserve readArray(intCount)
        Input #intFileNum, strRecordData
        readArray(intCount) = strRecordData
        intCount = intCount + 1
    Loop
    Close #intFileNum
     
    RetEmailFolders = readArray
End Function

Open in new window


I am trying to  debug this code as this is giving an error "Run time error 13 type mismatch on the
below line
ReDim arrCounts(LBound(arrFolderNames) To UBound(arrFolderNames))

Open in new window


This macro read the various inbox address from the text file and give the number email present in each share box. Also please find attached the file from where it is reading the address of the inbox.

Thanks
surah79Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

are you sure the array is not empty?

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
surah79Author Commented:
Hi Rgonzo as per screen shot attached it doesn't look like that array is empty? It is run succefully at your end after changing the Inbox address and file location?

Thanks
Array-Screen-Shot.docx
0
surah79Author Commented:
Hi My apologies i think the mistake there is letter 's' is missing from "arrayFolderNames"

arrFolderName = RetEmailFolders

Open in new window


It working now

thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.