Loop gets limited (1 Viewer)

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Hi All,

My VBA script uses a loop to download attachments from Outlook into a folder on C.
It works well without issues but imports only 8-10 email attachments at a time. I do not get any error in the code and when I click the
Import button on the Access Form, it again imports another 8-10 items.
Not sure why it does limit to 8-10 items rather than go through all the items in WeeklyProceedings Inbox.
There are 30-40 Proceedings daily.

Code:
Private Sub cmdOutlook_Click()

'import attachments from WeeklyProceedings Mailbox and saving it in C:\beData\prof_data\Attachments

    Dim olApp As Object
    Dim MYFOLDER As Object
    Dim OlItems As Object
    Dim olMail As Object
    Dim x As Integer
    Dim subject As String
    Dim strFile As String
    Dim strFolderpath As String
    Dim objDestfolder As Object
    Dim mychar As Object
    Dim sreplace As String
    
    DoCmd.OpenForm "frmpleasewait"
    
    DoCmd.SetWarnings False
    
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number = 429 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    
    strFolderpath = "C:\beData\prof_data"
    'On Error Resume Next
    
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\Attachments\"
    
    Set MYFOLDER = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders("Inbox")
    Set objDestfolder = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders.Item("Folders").Folders.Item("Archive_Proc")
    
    Set OlItems = MYFOLDER.Items
    
    For Each olMail In OlItems
        If olMail.subject Like "*Proceeding ID*" Then
            strFile = olMail & ".XML"
            strFile = strFolderpath & strFile
            If olMail.Attachments.Count > 0 Then
                For x = 1 To olMail.Attachments.Count
                    olMail.Attachments.Item(x).SaveAsFile strFile
                Next x
                
                subject = olMail.subject
                sreplace = "_"
                subject = Replace(subject, " ", sreplace)
                olMail.Body = olMail.Body & vbCrLf & "The file was processed " & Now()
                olMail.subject = "Processed - " & subject
                olMail.Move objDestfolder
                'olMail.Save

            End If
        End If
    Next
 
    Set olMail = Nothing
    Set olApp = Nothing
    
    DoCmd.Close acForm, "frmpleasewait"
    
    MsgBox ("Success")
    DoCmd.SetWarnings True

End Sub

TIA
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 23:52
Joined
Oct 29, 2018
Messages
21,467
Since your code is moving the attachment as you save them, you end up skipping every other one. Try saving all the attachments without moving them first, then do another loop to move them.
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Since your code is moving the attachment as you save them, you end up skipping every other one. Try saving all the attachments without moving them first, then do another loop to move them.
I am not sure what you mean by to save all the attachments before moving them? I would need help to modify the above code.

Thanks
 

cheekybuddha

AWF VIP
Local time
Today, 07:52
Joined
Jul 21, 2014
Messages
2,274
Also, try commenting out the line DoCmd.SetWarnings False before running your code.

You may well be hiding errors that might give you an idea of what's wrong.

I suspect some judicious use of DoEvents in your loop might help.
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 23:52
Joined
Oct 29, 2018
Messages
21,467
I am not sure what you mean by to save all the attachments before moving them? I would need help to modify the above code.

Thanks
You have a loop:
Code:
For Each olMail In OlItems
where you execute these two:
Code:
olMail.Attachments.Item(x).SaveAsFile strFile
olMail.Move objDestfolder
All I'm saying is split them up and create two loops, so you can execute those two lines in separate loop.
For instance:

Loop1
.SaveAsFile etc

Loop2
.Move objDestfolder

Just a thought...
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 02:52
Joined
Feb 19, 2002
Messages
43,257
A more efficent way to do this type of loop processing when your code will modify the loop index, is to loop backwards. start with the last item and decrement the loop until you get to 0. That way you only need to loop through the items once.
Code:
                x = olMail.Attachments.Count
                Do until x = 0
                    olMail.Attachments.Item(x).SaveAsFile strFile
                    x = x -1
                Loop
Or, use the For Each method.
Code:
    For Each file In filefolder
    ''' move file
    Next
I don't have any code handy that does For Each method for attachments but it should be similar to what I posted for the file folder
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Hi,

I had been on vacation and just joined this week. I tried your suggestion but it failed. Probably the For loop wasn't correct.

This is my code. How to modify to include your advise?

............................................
Code:
Set MYFOLDER = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders("Inbox")
    Set objDestfolder = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders.Item("Folders").Folders.Item("Archive_Proc")
    
    Set OlItems = MYFOLDER.Items
    
    For Each olMail In OlItems
        If olMail.subject Like "*Proceeding ID*" Then
            strFile = olMail & ".XML"
            strFile = strFolderpath & strFile
            If olMail.Attachments.Count > 0 Then
                For x = 1 To olMail.Attachments.Count
                    olMail.Attachments.Item(x).SaveAsFile strFile
                Next x
                
                subject = olMail.subject
                sreplace = "_"
                subject = Replace(subject, " ", sreplace)
                olMail.Body = olMail.Body & vbCrLf & "The file was processed " & Now()
                olMail.subject = "Processed - " & subject
                olMail.Move objDestfolder
                'olMail.Save

            End If
        End If
    Next
 
    Set olMail = Nothing
    Set olApp = Nothing
    
    DoCmd.Close acForm, "frmpleasewait"
    
    MsgBox ("Success")


................................

TIA
 

pbaldy

Wino Moderator
Staff member
Local time
Yesterday, 23:52
Joined
Aug 30, 2003
Messages
36,125
Pay attention to Pat's code. She's looping backwards, you're still looping forwards.

My gut tells me you'll keep overwriting the same file since strFile never changes, though maybe I'm missing something.
 

xavier.batlle

New member
Local time
Today, 08:52
Joined
Sep 1, 2023
Messages
19
I think the problem is that you are moving the mails in the For Each you are looping.
First of all, I'd try to execute the code without moving the mail: (oldMail.Move objDestFolder). If it works properly then I suggest you to copy the mails into a new Collection and loop through it instead of looping the mail folder.
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Pay attention to Pat's code. She's looping backwards, you're still looping forwards.

My gut tells me you'll keep overwriting the same file since strFile never changes, though maybe I'm missing something.
Can you help with my code with how to loop backwards?

TIA
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Sure, copy Pat's code.
I modified but still it stops after importing few items.If there are 30+ items, it stops at 18 and I again click the event.

Code:
Set OlItems = MYFOLDER.Items
    
    For Each olMail In OlItems
        If olMail.subject Like "*Proceeding ID*" Then
            strFile = olMail & ".XML"
            strFile = strFolderpath & strFile
            If olMail.Attachments.Count > 0 Then
                'For x = 1 To olMail.Attachments.Count
                    x = olMail.Attachments.Count
                    Do Until x = 0
                        olMail.Attachments.Item(x).SaveAsFile strFile
                         x = x - 1
                    Loop
                'Next x
                
                subject = olMail.subject
                sreplace = "_"
                subject = Replace(subject, " ", sreplace)
                olMail.Body = olMail.Body & vbCrLf & "The file was processed " & Now()
                olMail.subject = "Processed - " & subject
                olMail.Move objDestfolder
                'olMail.Save

            End If
        End If
    Next
 
    Set olMail = Nothing
    Set olApp = Nothing
    
    DoCmd.Close acForm, "frmpleasewait"
 

pbaldy

Wino Moderator
Staff member
Local time
Yesterday, 23:52
Joined
Aug 30, 2003
Messages
36,125
I will let @Pat Hartman respond, as it was her code. I just noticed you weren't using it.
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 02:52
Joined
Feb 19, 2002
Messages
43,257
You are not deleting the attachments so looping backwards doesn't help. It is the emails you are deleting and so that is the loop you need to worry about.
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 07:52
Joined
Sep 12, 2006
Messages
15,648
Can you try just saving or displaying the attachment names somehow first to make sure your iteration is correct. Then include code to manipulate the attachments. That's what I would do I think.
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
You are not deleting the attachments so looping backwards doesn't help. It is the emails you are deleting and so that is the loop you need to worry about.
I am confused by "not deleting the attachments". I am just going through the emails and moving them to a folder.
Can you tell me which line(s), I need to modify?

Thanks
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 02:52
Joined
Feb 19, 2002
Messages
43,257
Get a count of the emails. Then instead of for each, use "Do Until EmailCount = 0" and increment by -1
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:52
Joined
Sep 21, 2011
Messages
14,253
Also it appears you are overwriting the file all the time?, so will only ever have one, the last?

Do what I do.
Set breakpoints and walk your code with F8 and inspect what you have.
 
Last edited:

Pat Hartman

Super Moderator
Staff member
Local time
Today, 02:52
Joined
Feb 19, 2002
Messages
43,257
I forgot to comment on that.
Code:
                    Do Until x = 0
                        strFile = strFolderpath & olMail.Attachments.Item(x).Name
                        olMail.Attachments.Item(x).SaveAsFile strFile
                         x = x - 1
                    Loop
I don't know if there is a .name property and the syntax might not be correct but you need to set the name inside the loop otherwise you will just overwrite the attachments and end up with only the last one.
 

prasadgov

New member
Local time
Today, 02:52
Joined
Oct 12, 2021
Messages
14
Get a count of the emails. Then instead of for each, use "Do Until EmailCount = 0" and increment by -1
I modified my code to use Do Loop and count mails first and also used the .Name

Code:
 Set OlItems = MYFOLDER.Items
    
    'For Each olMail In OlItems
        y = olMail.Count
        Do Until y = 0
            If olMail.subject Like "*Proceeding ID*" Then
                strFile = olMail & ".XML"
                strFile = strFolderpath & strFile
                If olMail.Attachments.Count > 0 Then
                    'For x = 1 To olMail.Attachments.Count
                        x = olMail.Attachments.Count
                        Do Until x = 0
                            'olMail.Attachments.Item(x).SaveAsFile strFile
                             strFile = strFolderpath & olMail.Attachments.Item(x).Name
                             olMail.Attachments.Item(x).SaveAsFile strFile
                             x = x - 1
                        Loop
                    'Next x
                    
                    subject = olMail.subject
                    sreplace = "_"
                    subject = Replace(subject, " ", sreplace)
                    olMail.Body = olMail.Body & vbCrLf & "The file was processed " & Now()
                    olMail.subject = "Processed - " & subject
                    olMail.Move objDestfolder
                    'olMail.Save
    
                End If
            End If
            y = y - 1
        Loop
    'Next
 
    Set olMail = Nothing
    Set olApp = Nothing

Is this the right way?
 

Users who are viewing this thread

Top Bottom