Loop gets limited

P

prasadgov

Member
Local time
Today, 01:01
Joined
Oct 12, 2021
Messages
140
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
 
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.
 
theDBguy said:
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.
Click to expand...
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
 
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.
 
prasadgov said:
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
Click to expand...
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...
 
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
 
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
 
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.
 
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.
 
pbaldy said:
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.
Click to expand...
Can you help with my code with how to loop backwards?

TIA
 
pbaldy said:
Sure, copy Pat's code.
Click to expand...
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"
 
I will let @Pat Hartman respond, as it was her code. I just noticed you weren't using it.
 
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.
 
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.
 
Pat Hartman said:
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.
Click to expand...
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
 
Get a count of the emails. Then instead of for each, use "Do Until EmailCount = 0" and increment by -1
 
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:
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.
 
Pat Hartman said:
Get a count of the emails. Then instead of for each, use "Do Until EmailCount = 0" and increment by -1
Click to expand...
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?
 
You must log in or register to reply here.

Similar threads

P
Truncated file header
Replies
3
Views
517
Gasman
Gasman
A
Automation Error
Replies
10
Views
222
The_Doc_Man
The_Doc_Man
Jason Lee Hayes
Solved Open Outlook & check for new mail where search criteria is applied to the email subject line
Replies
19
Views
1,162
Jason Lee Hayes
Jason Lee Hayes
LarryE
Solved Using ACCESS, WORD and OUTLOOK to send bulk E-Mails
2
Replies
38
Views
933
MajP
MajP
A
Solved VBA code for deleting Outlook 'Appointments' lying within a specified date range
Replies
8
Views
1,176
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom