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