Loop gets limited (1 Viewer)

[prasadgov]

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.

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]

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]

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]

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 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:

For Each olMail In OlItems

where you execute these two:

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]

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.

                x = olMail.Attachments.Count
                Do until x = 0
                    olMail.Attachments.Item(x).SaveAsFile strFile
                    x = x -1
                Loop

Or, use the For Each method.

    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]

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?

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

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]

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]

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]

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

 

[pbaldy]

Can you help with my code with how to loop backwards?

TIA

Sure, copy Pat's code.

 

[prasadgov]

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.

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]

I will let @Pat Hartman respond, as it was her code. I just noticed you weren't using it.

 

[Pat Hartman]

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]

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]

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]

Get a count of the emails. Then instead of for each, use "Do Until EmailCount = 0" and increment by -1

 

[Gasman]

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.

 

[Pat Hartman]

I forgot to comment on that.

                    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]

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

 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?