access loop in Outlook

[101287]

I have the following code but when I executed I the records are repeated. I looks that it reads the folder items for 5 unique items. Then it reset back to the 5 first items again. It thought that with the CTHL loop this problem will not happen. In reality, need help don't understand and would like for guidance to continue to learn.

Thnank you for help.

CODE BELOW:
Function xemailReadFolder()
'This is the code that works
Dim Replacespecialcharacters As String
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.Namespace
Dim Olfolder As Outlook.MAPIFolder
Dim OlAccept As Outlook.MAPIFolder
Dim OlDecline As Outlook.MAPIFolder
Dim OlFailed As Outlook.MAPIFolder
Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Rst As Recordset
Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
'Create a connection to outlook
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
'Set up the folders the mails are going to be deposited in
'Open the inbox
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
'Set OlItems = Olfolder.Items
Set OlAccept = Olfolder.Folders("Accept") 'Folder need to be define inside Inbox
Set MyFolder = Olfolder.Folders(5)
Debug.Print "MyFolder=" & MyFolder ' To display folder selected


Set OlItems = MyFolder.Items 'Myfolder.Items
'Set up a loop to run till the inbox is empty (otherwise it skips some)
Dim itemCounter As Double
itemCounter = 0

Do Until OlItems.Count = 0 'OlItems.Count = 0

'Reset the olitems object otherwise new incoming mails and moving mails get missed

' Set OlItems = OlItems.Items
' Set OlItems = MyFolder.Items
For Each OlMail In OlItems
'Replacespecialcharacters = Replace(OlMail.Body, vbNewLine, " ") 'Replace newline with blanks
Text = OlMail.Body
Rst.AddNew
begTextPointer = InStr(1, Replacespecialcharacters, "Hostname: ", vbTextCompare) '496
sarea = Mid(Replacespecialcharacters, begTextPointer + Len(begTextPointer) + 7, 50)

itemCounter = itemCounter + 1
Rst.Update
OlItems(OlItems.Count).Move OlAccept
Debug.Print "ItemCounter=" & itemCounter
Set OlItems = MyFolder.Items


Next
Loop


MsgBox "Your wish is my command. New mails have been checked. Please check the tbl_temp for details", vbOKOnly
End Function

 

[SimonEireconsulting]

What is Olfolder.Folders(5)???

Shouldn't you be looping through inbox items - ie Olfolder.Items

So the line you have commented out:
'Set OlItems = Olfolder.Items
I think should be used INSTEAD of:
Set OlItems = MyFolder.Items

and then again inside the FOR loop