Loop to get emails from Outlook 365 has broken, and I cant work out why !

[netrixuser]

I had some working code, mainly compiled from "bits" on the web, with some help form a couple of posts/replies in Mr Excel. The code was working.
High level summary:
Emails received from a certain sender with a certain subject line
Emails contain a zipped file "Log.zip"
Within the Zip is a csv file with a unique number appended to filename containing the date and time the csv file was created ie. 31082023115237 for 31/08/2023 at 11:52:37)
Three sheets in Workbook:
Scratch Sheet - the csv file is "imported" via a query. The code calls other subs that manipulate the data and moves it to the Current Alerts tab, then deletes the data from Scratch Sheet
Current Alerts - stores the current alerts
Resource Sheet - not used other than to store the unique number mentioned above for use at a later date maybe

For testing I have two unread emails in the Outlook folder. The code is only working for the first "pass" of

For Each Alertemail In Folder.Items

To note, this code worked for 20 unread emails at one point - so I have broken it somewhere but I cannot figure out where
I have added Debug.Print Folder.Items.Count at various stages in the code - it returns "2" immediately after the "For Each Alertmail" code above, and it returns "1" just before the code

Next Alertemail

But it now doesn't move to the next email

Currently the code to call other subs from within are remarked out as I just need to get the loop working to process all unread emails, and please excuse all my comments in the code - I am trying to better understand what each line is doing - feel free to correct those if anything is incorrect. I do have some Variables set at the top of the VBA editor (Global Variables ??) a couple are pertinent to this procedure. I have option explicit set at the to too and Compile VBA Project returns no errors.

I wont class myself as a complete newbie, but not that experienced with VBA. I think best practice is to declare all variables at the top of the code, which isn't the case below - when compiling this it became a pain for me to recall what class a variable was set as so I started writing them where the code for that variable was written - apologies if this is a big no-no.

As always, thanks in advance for any help you can give
Regards - Netrix

Sub TESTGetEmailFromOutlook()
' Need References added for Microsoft Outlook Object Library and
' "Microsoft Shell Controls And Automation"
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder   'variable to store the name of the Outlook folder
Dim Alertemail As Variant
Dim OutlookAtch As Object
Dim NewFileName As String
Dim OutlookSent As Variant
Dim lastRow As Integer   'variable used to increment row by 1 when refreshing the query
    lastRow = 1
Const AlertemailSenderAddress = "no-reply@abc123.com"
Const AlertemailSubjectKey = "Missing Recording Alerts Update"

Dim shell As Shell32.shell
Dim DestinationFolder As Shell32.Folder
Dim SourceFolder As Shell32.Folder

    'Configure Paths for zip files on disk
    Set shell = New Shell32.shell
    Dim AttachmentDestinationFolder As Variant

    AttachmentDestinationFolder = "C:\Temp\UnzippedAttachments" 
    Set DestinationFolder = shell.Namespace(AttachmentDestinationFolder)
    
    'check for Attachment Destination Folder
    If Dir(AttachmentDestinationFolder, vbDirectory) = "" Then
        MsgBox "Destination folder not found, please create: " & AttachmentDestinationFolder, vbExclamation, "Exit"
        Exit Sub
    End If
    
Dim AttachmentSourceFileName As String 'variable to store the name of the zipped file
AttachmentSourceFileName = "c:\Temp\Attachments\log.zip" 'set the variable to Path:Log.zip
    
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Dim SharedMailbox As Object 'variable to store name of Outlook folder
Dim MailFolder As Object

Dim OutlookNS As Outlook.Namespace
    Set OutlookNS = OutlookApp.GetNamespace("MAPI")
    OutlookNS.Logon
    Set SharedMailbox = OutlookNS.CreateRecipient("SharedMail@ABC.com") 'store Outlook folder as the Variable "SharedMailbox"
    SharedMailbox.Resolve
    
    'if the ShareMailbox name exists, store the name of the Outlook folder as the Variable "Folder"
    If SharedMailbox.Resolved Then

        Set Folder = OutlookNS.GetSharedDefaultFolder(SharedMailbox, olFolderInbox).Folders("New Alerts")
    End If

    'if Outlook folder is empty - display message and end code
    If Folder.UnReadItemCount = 0 Then
        MsgBox ("There are no Unread Emails - The script will now end"), vbExclamation
    End
    End If
    
Dim UnredEmailCnt As Integer 'variable to store number of unread emails in Oulook folder
    
    'if unread emails, count and display number
    If Folder.UnReadItemCount > 0 Then
        UnredEmailCnt = Folder.UnReadItemCount
        MsgBox "Found " & UnredEmailCnt & " matching Alert E-mail(s)"
    End If
    
Dim EmailSubject As String 'variable to store email subject
Dim EmailSenderEmailAddress As String 'variable to store email senders address


For Each Alertemail In Folder.Items

Debug.Print Folder.Items.Count    'returns 2 here
    
EmailSubject = LCase(Alertemail.Subject) 'assign value to variable
EmailSenderEmailAddress = LCase(Alertemail.SenderEmailAddress) 'assign value to variable


    If ((StrComp(EmailSenderEmailAddress, AlertemailSenderAddress, vbTextCompare) = 0) And InStr(1, EmailSubject, LCase(AlertemailSubjectKey), vbTextCompare)) Then
        If Alertemail.UnRead = True Then
      
                Alertemail.Attachments.Item(1).SaveAsFile (AttachmentSourceFileName)        'Save zipped attachment to Attachments folder
                Set SourceFolder = shell.Namespace(AttachmentSourceFileName)                   'set the source file name to path:Log.zip
                DestinationFolder.CopyHere SourceFolder.Items                                '??? UnZip File and save csv file to Unzipped Attachments Folder
            
                Alertemail.UnRead = False 'set email to read - needed if deleting on next line ???
                Alertemail.Delete         'delete email
                
                Dim oFSO As Object
                Dim oFolder As Object
                Dim oFile As Object
            
                Set oFSO = CreateObject("Scripting.FileSystemObject")
                Set oFolder = oFSO.GetFolder(AttachmentDestinationFolder) 'folder where attachment (csv) file is temp stored
                        
                For Each oFile In oFolder.Files  'for loop - not really necessary as only one csv file in the folder at any one time ??
                    FileName = oFile.Path
                                 
                'store the unique number from the filename in the Resource Sheet
                fname = Left(Right(FileName, 18), 14)
                Sheets("Resource Sheet").Range("S1").Value = fname
                Sheets("resource sheet").Range("S1").Copy
                Sheets("resource sheet").Range("T1").Insert Shift:=xlDown
                    With Sheets("resource sheet").Range("AT1").End(xlDown)
                        Sheets("resource sheet").Range("U1").Value = Application.WorksheetFunction.CountIf(Range("T1", Range("T1").End(xlDown)), ">1")
                    End With
                Exit For
                    
                    Next oFile
                                    Debug.Print Folder.Items.Count ' returns 1 here
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Scratch Sheet")
On Error Resume Next
                    With ws.QueryTables.Add(Connection:="TEXT;" & FileName, _
                            Destination:=ws.Range("A" & lastRow))
                         .TextFileParseType = xlDelimited
                         .TextFileCommaDelimiter = True
                         '.TextFileStartRow = 2
                         .Refresh
                    End With
                                  
                Kill (FileName) 'delete file from AttachmentDestinationFolder
                'Call DeleteExisting 'new attachment will have existing alerts - delete these
                'Call CopyNew 'copy new alerts from Scratch Sheet to Current Alerts sheet
                'Call RemClosed ' remove alerts from Current Alerts that are CLOSED in Scatch Sheet
                        
        End If
    End If
                                    Debug.Print Folder.Items.Count ' returns 1 here
Next Alertemail 'doesn't trigger - code moves down to Set Folder = nothing

'Set MailFolder = Nothing
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
Set shell = Nothing
Set DestinationFolder = Nothing
Set OutlookNS = Nothing
Set SourceFolder = Nothing
Set oFSO = Nothing
Set oFolder = Nothing
Set ws = Nothing
Set SharedMailbox = Nothing

End Sub

 

[netrixuser]

Well, I have found the issue but do not know why this causes it - so any help still gratefully received...
To test, I moved the "Next OutlookMail" command to just below the "For Each OutlookMail in Folder.Items" command" and then placed a simple "If the mail is unread, mark it as read" command and that loop worked ok in that the loop followed the Next OutlookMail command and marked the two test emails as unread.

The command to delete the email, just after it is marked as unread in the main code was the culprit - I removed "OutlookMail.delete" from the section and the For/Next loop works.... but why ?

​

 

[RoryA]

When deleting, you should always work backwards - it's the same with ranges or any collection. Essentially, the internal counter will be incremented when the Next line is processed, so the code will be checking for the second item in the collection, but there's only one now (which it thinks was already processed) because you deleted the first one, so it simply stops.

 

[netrixuser]

When deleting, you should always work backwards - it's the same with ranges or any collection. Essentially, the internal counter will be incremented when the Next line is processed, so the code will be checking for the second item in the collection, but there's only one now (which it thinks was already processed) because you deleted the first one, so it simply stops.

Ah, makes perfect sense ! thank you