Looping through folders in outlook

[freshpoet]

Hi All,

Im looping through some folders in outlook but once the code does about 5 loops I get a run time error: '430' Class does not support Automation or does not support expected interface at line code:

If CDate(OutlookMail.ReceivedTime) >= Range("Start_of_Month").Value Then


For intCount = 1 To 16


Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing


Set OutlookApp = New Outlook.Application


Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")


Set Folder = OutlookNamespace.Folders("croesus support").Folders("Boîte de réception").Folders(intCount)


For Each OutlookMail In Folder.Items





If TypeName(OutlookMail) = "MailItem" Then

If CDate(OutlookMail.ReceivedTime) >= Range("Start_of_Month").Value Then

If CDate(OutlookMail.ReceivedTime) <= Range("End_of_Month").Value Then

Incoming = Incoming + 1




Range("Email_Sender").Offset(i, 0) = OutlookMail.ReceivedTime
Range("Email_Sender").Offset(i, 0).Columns.AutoFit
Range("Email_Sender").Offset(i, 0).VerticalAlignment = xlTop

i = i + 1

End If
End If
End If






Next OutlookMail


Range("Email_Sender").Offset(i, 0) = "End Of Inbox"
Range("Email_Sender").Offset(i, 0).Columns.AutoFit
Range("Email_Sender").Offset(i, 0).VerticalAlignment = xlTop

Range("Email_Date").Offset(i, 0) = "End Of Inbox"
Range("Email_Date").Offset(i, 0).Columns.AutoFit
Range("Email_Date").Offset(i, 0).VerticalAlignment = xlTop

Range("Recipient").Offset(i, 0) = "End Of Inbox"
Range("Recipient").Offset(i, 0).Columns.AutoFit
Range("Recipient").Offset(i, 0).VerticalAlignment = xlTop

Range("Email_Status").Offset(i, 0) = "End Of Inbox"
Range("Email_Status").Offset(i, 0).Columns.AutoFit
Range("Email_Status").Offset(i, 0).VerticalAlignment = xlTop

Range("Total").Offset(i, 0) = "End Of Inbox"
Range("Total").Offset(i, 0).Columns.AutoFit
Range("Total").Offset(i, 0).VerticalAlignment = xlTop


Next intCount




End Sub

[freshpoet]

Any ideas? I would rather not copy paste the code 16 times... lol

[skatonni]

No error found with your code. I went as far as creating Start_of_Month and End_of_Month.

One possible enhancement is to take creating Outlook out of the loop.

This code does not generate an error.

Option Explicit ' Consider this mandatory

Sub LoopError()

    ' With reference set to Outlook Object Library
    
    Dim Folder As Outlook.Folder
    Dim OutlookNamespace As Namespace
    Dim OutlookApp As Outlook.Application
    
    Dim OutlookItem As Object
    Dim OutlookMail As MailItem
    Dim intCount As Long
    Dim i As Long
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

    For intCount = 1 To 16
        
        Set Folder = OutlookNamespace.Folders("croesus support").Folders("Boîte de réception").Folders(intCount)
        Debug.Print "Folder " & intCount & " - " & Folder
        
        'Debug.Print "Range("Start_of_Month").Value: " & Range("Start_of_Month").Value

        For Each OutlookItem In Folder.Items
    
            If TypeName(OutlookItem) = "MailItem" Then
            
                Set OutlookMail = OutlookItem
                
                Debug.Print " OutlookMail.ReceivedTime....: " & OutlookMail.ReceivedTime
                
                If CDate(OutlookMail.ReceivedTime) >= Range("Start_of_Month").Value Then
    
                    If CDate(OutlookMail.ReceivedTime) <= Range("End_of_Month").Value Then
                        
                        Debug.Print " Found mail with ReceivedTime: " & OutlookMail.ReceivedTime
                        'Range("Email_Sender").Offset(i, 0) = OutlookMail.ReceivedTime
                        'Range("Email_Sender").Offset(i, 0).Columns.AutoFit
                        'Range("Email_Sender").Offset(i, 0).VerticalAlignment = xlTop
    
                        i = i + 1
    
                    End If
                End If
            End If
    
        Next
        
        'Range("Email_Sender").Offset(i, 0) = "End Of Inbox"
        'Range("Email_Sender").Offset(i, 0).Columns.AutoFit
        'Range("Email_Sender").Offset(i, 0).VerticalAlignment = xlTop
    
        'Range("Email_Date").Offset(i, 0) = "End Of Inbox"
        'Range("Email_Date").Offset(i, 0).Columns.AutoFit
        'Range("Email_Date").Offset(i, 0).VerticalAlignment = xlTop
    
        'Range("Recipient").Offset(i, 0) = "End Of Inbox"
        'Range("Recipient").Offset(i, 0).Columns.AutoFit
        'Range("Recipient").Offset(i, 0).VerticalAlignment = xlTop
    
        'Range("Email_Status").Offset(i, 0) = "End Of Inbox"
        'Range("Email_Status").Offset(i, 0).Columns.AutoFit
        'Range("Email_Status").Offset(i, 0).VerticalAlignment = xlTop
    
        'Range("Total").Offset(i, 0) = "End Of Inbox"
        'Range("Total").Offset(i, 0).Columns.AutoFit
        'Range("Total").Offset(i, 0).VerticalAlignment = xlTop
        
        Set Folder = Nothing
    
    Next intCount
    
    Set OutlookApp = Nothing
    Set OutlookNamespace = Nothing
    Set Folder = Nothing

    Set OutlookItem = Nothing
    Set OutlookMail = Nothing
        
End Sub

From here, if there is no error, uncomment lines until the error returns.

(fyi - In future put enough code so potential responders can copy paste and not have to put in time generating code with the possibility of adding their own errors.)