For Each loop not getting all Email Items

Status
Not open for further replies.
H

Hunter57

I am using Access 2003 to Automate Outlook and archive Email as msg files to

the hard drive. The For Each loop (For Each objitm In objFolder.Items) in my

code does not find all of the emails and I am unable to find out why this is

happening. It only finds about half of the emails in the Outlook folder.

Everything else appears to be working properly.

Private Sub cmdSetAchiveFolder_Click()

Dim objApp As Object

Dim objNS As Object 'NameSpace

Dim colFolders As Object ' Outlook.Folders

Dim objFolder As Object ' Outlook.MAPIFolder

Dim objitm As Object

Dim objMail As Object

Dim strAppTitle As String ' Application Window Title

Dim strFolderPath As String

Dim strArchiveFolder As String

Dim arrFolders() As String

Dim i As Long

' Get the Folder name where the emails will be archived

strArchiveFolder = Me.cboDestinationFolder.Value

' Get the Outlook Folder Path

strFolderPath = Me.txtOutlookFolder.Value

If isAppThere("Outlook.Application") = False Then

' Outlook is not open, create a new instance

Set objApp = CreateObject("Outlook.Application")

Else

' Outlook is already open--use this method

Set objApp = GetObject(, "Outlook.Application")

End If

Set objNS = objApp.GetNamespace("MAPI")

' Get the folder by the Folder Path

On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "\")

' Eliminate any leading "\" from the string

Do While Left(strFolderPath, 1) = "\"

strFolderPath = Right(strFolderPath, (Len(strFolderPath) - 1))

Loop

arrFolders() = Split(strFolderPath, "\")

Set objFolder = objNS.Folders.Item(arrFolders(0))

If Not objFolder Is Nothing Then

For i = 1 To UBound(arrFolders)

Set colFolders = objFolder.Folders

Set objFolder = Nothing

Set objFolder = colFolders.Item(arrFolders(i))

If objFolder Is Nothing Then

Exit For

End If

Next

End If

If Not objFolder Is Nothing Then

This is the loop where the problem occurs:

For Each objitm In objFolder.Items

Debug.Print "Email " & objitm.Subject & " was found."

' Outlook.OlObjectClass Const olMail = 43 (&H2B)

If objitm.Class = 43 Then

Set objMail = objitm

End If

' Call a Procedure to Save the Email to the Archive Folder

Call ArchiveEmails(objMail, strArchiveFolder)

' Delete the email

If blnArchived = True Then

Debug.Print "Email " & objMail.Subject & " was archived."

objMail.Delete

Else

Debug.Print "Email " & objMail.Subject & " was not deleted."

End If

Next objitm

End If

Set objMail = Nothing

Set objitm = Nothing

Set objFolder = Nothing

Set colFolders = Nothing

Set objNS = Nothing

Set objApp = Nothing

End Sub
 
You're not the only one who has encountered this issue - nearly every Outlook

developer comes across this at some point!

The problem is you are deleting e-mails, thus altering the population of the

collection and affecting the loop.

The trick is to count backwards - e.g.:

For intX = objItems.Count To 1 Step -1

> ..

Set objMail = objItems.Item(intX)

objMail.Delete

> ..

Next

Eric Legault - , MCDBA, MCTS (SharePoint programming, etc.)

"Hunter57" wrote:


> I am using Access 2003 to Automate Outlook and archive Email as msg files to
> the hard drive. The For Each loop (For Each objitm In objFolder.Items) in my
> code does not find all of the emails and I am unable to find out why this is
> happening. It only finds about half of the emails in the Outlook folder.

> Everything else appears to be working properly.

> Private Sub cmdSetAchiveFolder_Click()

> Dim objApp As Object
> Dim objNS As Object 'NameSpace
> Dim colFolders As Object ' Outlook.Folders
> Dim objFolder As Object ' Outlook.MAPIFolder
> Dim objitm As Object
> Dim objMail As Object
> Dim strAppTitle As String ' Application Window Title
> Dim strFolderPath As String
> Dim strArchiveFolder As String
> Dim arrFolders() As String
> Dim i As Long

> ' Get the Folder name where the emails will be archived
> strArchiveFolder = Me.cboDestinationFolder.Value

> ' Get the Outlook Folder Path
> strFolderPath = Me.txtOutlookFolder.Value

> If isAppThere("Outlook.Application") = False Then
> ' Outlook is not open, create a new instance
> Set objApp = CreateObject("Outlook.Application")
> Else
> ' Outlook is already open--use this method
> Set objApp = GetObject(, "Outlook.Application")
> End If

> Set objNS = objApp.GetNamespace("MAPI")

> ' Get the folder by the Folder Path
> On Error Resume Next

> strFolderPath = Replace(strFolderPath, "/", "\")
> ' Eliminate any leading "\" from the string
> Do While Left(strFolderPath, 1) = "\"
> strFolderPath = Right(strFolderPath, (Len(strFolderPath) - 1))
> Loop

> arrFolders() = Split(strFolderPath, "\")
> Set objFolder = objNS.Folders.Item(arrFolders(0))
> If Not objFolder Is Nothing Then
> For i = 1 To UBound(arrFolders)
> Set colFolders = objFolder.Folders
> Set objFolder = Nothing
> Set objFolder = colFolders.Item(arrFolders(i))
> If objFolder Is Nothing Then
> Exit For
> End If
> Next
> End If

> If Not objFolder Is Nothing Then

> This is the loop where the problem occurs:
> For Each objitm In objFolder.Items
> Debug.Print "Email " & objitm.Subject & " was found."
> ' Outlook.OlObjectClass Const olMail = 43 (&H2B)
> If objitm.Class = 43 Then
> Set objMail = objitm
> End If
> ' Call a Procedure to Save the Email to the Archive Folder
> Call ArchiveEmails(objMail, strArchiveFolder)
> ' Delete the email
> If blnArchived = True Then
> Debug.Print "Email " & objMail.Subject & " was archived."
> objMail.Delete
> Else
> Debug.Print "Email " & objMail.Subject & " was not deleted."
> End If
> Next objitm
> End If

> Set objMail = Nothing
> Set objitm = Nothing
> Set objFolder = Nothing
> Set colFolders = Nothing
> Set objNS = Nothing
> Set objApp = Nothing

> End Sub
>
 
Hi Eric,

Thanks for the help. Of course. Now it makes sense. I suppose I did not

think of that because I was using a For Each loop instead of stepping through

an index.

Patrick Wood

"Eric Legault " wrote:


> You're not the only one who has encountered this issue - nearly every Outlook
> developer comes across this at some point!

> The problem is you are deleting e-mails, thus altering the population of the
> collection and affecting the loop.

> The trick is to count backwards - e.g.:

> For intX = objItems.Count To 1 Step -1
> ...
> Set objMail = objItems.Item(intX)
> objMail.Delete
> ...
> Next

> > Eric Legault - , MCDBA, MCTS (SharePoint programming, etc.)
>

>

>

> "Hunter57" wrote:
>
> > I am using Access 2003 to Automate Outlook and archive Email as msg files to
> > the hard drive. The For Each loop (For Each objitm In objFolder.Items) in my
> > code does not find all of the emails and I am unable to find out why this is
> > happening. It only finds about half of the emails in the Outlook folder.
> > Everything else appears to be working properly.
> > Private Sub cmdSetAchiveFolder_Click()
> > Dim objApp As Object
> > Dim objNS As Object 'NameSpace
> > Dim colFolders As Object ' Outlook.Folders
> > Dim objFolder As Object ' Outlook.MAPIFolder
> > Dim objitm As Object
> > Dim objMail As Object
> > Dim strAppTitle As String ' Application Window Title
> > Dim strFolderPath As String
> > Dim strArchiveFolder As String
> > Dim arrFolders() As String
> > Dim i As Long
> > ' Get the Folder name where the emails will be archived
> > strArchiveFolder = Me.cboDestinationFolder.Value
> > ' Get the Outlook Folder Path
> > strFolderPath = Me.txtOutlookFolder.Value
> > If isAppThere("Outlook.Application") = False Then
> > ' Outlook is not open, create a new instance
> > Set objApp = CreateObject("Outlook.Application")
> > Else
> > ' Outlook is already open--use this method
> > Set objApp = GetObject(, "Outlook.Application")
> > End If
> > Set objNS = objApp.GetNamespace("MAPI")
> > ' Get the folder by the Folder Path
> > On Error Resume Next
> > strFolderPath = Replace(strFolderPath, "/", "\")
> > ' Eliminate any leading "\" from the string
> > Do While Left(strFolderPath, 1) = "\"
> > strFolderPath = Right(strFolderPath, (Len(strFolderPath) - 1))
> > Loop
> > arrFolders() = Split(strFolderPath, "\")
> > Set objFolder = objNS.Folders.Item(arrFolders(0))
> > If Not objFolder Is Nothing Then
> > For i = 1 To UBound(arrFolders)
> > Set colFolders = objFolder.Folders
> > Set objFolder = Nothing
> > Set objFolder = colFolders.Item(arrFolders(i))
> > If objFolder Is Nothing Then
> > Exit For
> > End If
> > Next
> > End If
> > If Not objFolder Is Nothing Then
> > This is the loop where the problem occurs:
> > For Each objitm In objFolder.Items
> > Debug.Print "Email " & objitm.Subject & " was found."
> > ' Outlook.OlObjectClass Const olMail = 43 (&H2B)
> > If objitm.Class = 43 Then
> > Set objMail = objitm
> > End If
> > ' Call a Procedure to Save the Email to the Archive Folder
> > Call ArchiveEmails(objMail, strArchiveFolder)
> > ' Delete the email
> > If blnArchived = True Then
> > Debug.Print "Email " & objMail.Subject & " was archived."
> > objMail.Delete
> > Else
> > Debug.Print "Email " & objMail.Subject & " was not deleted."
> > End If
> > Next objitm
> > End If
> > Set objMail = Nothing
> > Set objitm = Nothing
> > Set objFolder = Nothing
> > Set colFolders = Nothing
> > Set objNS = Nothing
> > Set objApp = Nothing
> > End Sub
> >
 
Hi Eric,

It works great! Many thanks.

Pat Wood

"Eric Legault " wrote:


> You're not the only one who has encountered this issue - nearly every Outlook
> developer comes across this at some point!

> The problem is you are deleting e-mails, thus altering the population of the
> collection and affecting the loop.

> The trick is to count backwards - e.g.:

> For intX = objItems.Count To 1 Step -1
> ...
> Set objMail = objItems.Item(intX)
> objMail.Delete
> ...
> Next

> > Eric Legault - , MCDBA, MCTS (SharePoint programming, etc.)
>

>

>

> "Hunter57" wrote:
>
> > I am using Access 2003 to Automate Outlook and archive Email as msg files to
> > the hard drive. The For Each loop (For Each objitm In objFolder.Items) in my
> > code does not find all of the emails and I am unable to find out why this is
> > happening. It only finds about half of the emails in the Outlook folder.
> > Everything else appears to be working properly.
> > Private Sub cmdSetAchiveFolder_Click()
> > Dim objApp As Object
> > Dim objNS As Object 'NameSpace
> > Dim colFolders As Object ' Outlook.Folders
> > Dim objFolder As Object ' Outlook.MAPIFolder
> > Dim objitm As Object
> > Dim objMail As Object
> > Dim strAppTitle As String ' Application Window Title
> > Dim strFolderPath As String
> > Dim strArchiveFolder As String
> > Dim arrFolders() As String
> > Dim i As Long
> > ' Get the Folder name where the emails will be archived
> > strArchiveFolder = Me.cboDestinationFolder.Value
> > ' Get the Outlook Folder Path
> > strFolderPath = Me.txtOutlookFolder.Value
> > If isAppThere("Outlook.Application") = False Then
> > ' Outlook is not open, create a new instance
> > Set objApp = CreateObject("Outlook.Application")
> > Else
> > ' Outlook is already open--use this method
> > Set objApp = GetObject(, "Outlook.Application")
> > End If
> > Set objNS = objApp.GetNamespace("MAPI")
> > ' Get the folder by the Folder Path
> > On Error Resume Next
> > strFolderPath = Replace(strFolderPath, "/", "\")
> > ' Eliminate any leading "\" from the string
> > Do While Left(strFolderPath, 1) = "\"
> > strFolderPath = Right(strFolderPath, (Len(strFolderPath) - 1))
> > Loop
> > arrFolders() = Split(strFolderPath, "\")
> > Set objFolder = objNS.Folders.Item(arrFolders(0))
> > If Not objFolder Is Nothing Then
> > For i = 1 To UBound(arrFolders)
> > Set colFolders = objFolder.Folders
> > Set objFolder = Nothing
> > Set objFolder = colFolders.Item(arrFolders(i))
> > If objFolder Is Nothing Then
> > Exit For
> > End If
> > Next
> > End If
> > If Not objFolder Is Nothing Then
> > This is the loop where the problem occurs:
> > For Each objitm In objFolder.Items
> > Debug.Print "Email " & objitm.Subject & " was found."
> > ' Outlook.OlObjectClass Const olMail = 43 (&H2B)
> > If objitm.Class = 43 Then
> > Set objMail = objitm
> > End If
> > ' Call a Procedure to Save the Email to the Archive Folder
> > Call ArchiveEmails(objMail, strArchiveFolder)
> > ' Delete the email
> > If blnArchived = True Then
> > Debug.Print "Email " & objMail.Subject & " was archived."
> > objMail.Delete
> > Else
> > Debug.Print "Email " & objMail.Subject & " was not deleted."
> > End If
> > Next objitm
> > End If
> > Set objMail = Nothing
> > Set objitm = Nothing
> > Set objFolder = Nothing
> > Set colFolders = Nothing
> > Set objNS = Nothing
> > Set objApp = Nothing
> > End Sub
> >
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
S Outlook email to configure setup for each mail Outlook VBA and Custom Forms 1
T Pictures degrade each time an Outlook item is edited and re-saved Using Outlook 1
J Outlook 2016 After a search in all mailboxes, where is each message that was found? Using Outlook 6
L Cannot open PST file for first session each day Using Outlook 6
Hudas VBA find and open an email without looping thru each email in the inbox Outlook VBA and Custom Forms 1
K VBA to measure response time for each emails in a shared mailbox Outlook VBA and Custom Forms 11
B Saved emails in folders I created on left of screen are being erased as I open each folder Using Outlook 0
D How to forward each email x minutes after it arrives in inbox and hasn't been moved or deleted? Using Outlook 1
O "Pre-filled" text in each new message Using Outlook 2
I Different users connected to an IMAP email aren't syncing with each other Using Outlook 5
T VBA to process each email Outlook VBA and Custom Forms 10
M Outlook displays "choose folder" for each sent item. Using Outlook 2
T Setting Color codes for each user of a shared Calendar Using Outlook 1
C Exchange 2003 - Outlook 2003 - Calendar entries saving over each other Using Outlook 2
A Recurring meeting sending a invite for each meeting Using Outlook 1
H Re: record of sales for each contact BCM (Business Contact Manager) 1
C SQLDUMPER library does not turn on correctly when the computer isturned on each time. BCM (Business Contact Manager) 1
S ->[O2007] Parsing each line of a MailItem HTMLBody? Outlook VBA and Custom Forms 2
G Confirm Each Recipient in a New Outlook Mail Before it is Sent Outlook VBA and Custom Forms 4
G Confirm Each Recipient in a New Outlook Mail Before it is Sent Outlook VBA and Custom Forms 1
S How to add icon(or picture) field for each contact in contacts view Outlook VBA and Custom Forms 6
S Macro for Loop through outlook unread emails Outlook VBA and Custom Forms 2
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
A ItemAdd on Imap Folder get endless loop after saving item Using Outlook 5
makinmyway Trouble Installing BCM Outlook 2013; Endless Install Loop Happens Using Outlook 0
W Broken Folder Loop - Outlook 2007 (.oft files) Using Outlook 2
Forum Admin Endless loop when to the new Outlook Connector Using Outlook.com accounts in Outlook 0
S Business Contact Manager (BCM) causing Outlook crash loop BCM (Business Contact Manager) 3
K loop through distribution group (and potentially, embedded DGs) by Outlook VBA and Custom Forms 1
S Loop mail items within a Custom Search Folder Outlook VBA and Custom Forms 1
M If loop not running Outlook VBA and Custom Forms 1
M Outlook VBA Form not finding FOR LOOP -- Error message Outlook VBA and Custom Forms 2
R Loop Attachment (once again) Outlook VBA and Custom Forms 6
L Getting Index from dropdown inserted on ribbon Outlook VBA and Custom Forms 3
e_a_g_l_e_p_i Question about installing my Gmail account on my iPhone but still getting messages downloaded to my desktop Outlook. Using Outlook 3
P now on office 365 but getting error messages about missing Outlook 2013 cache folders Using Outlook 2
W Outlook 365 I am getting the "Either there is no default mail client" error when I try to send an email on excel Office 365 Using Outlook 1
H Outlook 365 issue getting details from embedded files, crashing routine Outlook VBA and Custom Forms 0
A Links in email getting error message about group policy Using Outlook 4
Commodore Getting rid of "This computer only" Using Outlook 4
V Outlook 2016 Multiple recurring tasks getting created Using Outlook 0
P PST file is getting huge under POP 3 Using Outlook 2
N contact notepad 'style' getting changed after clicking and running Activities Using Outlook 2
S Outlook [Online - Office365] perfomance is getting affected when accessing the mails using Redemptio Using Outlook 1
D Close Oulook after sending emails via vba without outbox getting stuck. Outlook VBA and Custom Forms 1
C im getting a type mismatch error Outlook VBA and Custom Forms 3
William getting custom form to load category colors Outlook VBA and Custom Forms 4
C Getting back previous computer owner Outlook email Using Outlook.com accounts in Outlook 1
B Recipient of a forwared message getting multiple emails Using Outlook 2

Similar threads

Back
Top