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.)