Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Nested Do Loop messing up For Loop 1

Status
Not open for further replies.

patriciaxxx

Programmer
Jan 30, 2012
277
GB
The ‘For Each varFile In .SelectedItems’ loop in the function below worked perfectly until I added the ‘Do Until nObjSelected > .SelectedItems.Count’ loop. Now it only enters the first varFile. But the Do Until loop works perfect in this scenario.

So how do you modify the code so both loops work.

'Uses the undocumented [Application.LoadFromText] syntax.
Private Function ObjLoadFromText()
On Error GoTo Err_Handler
Dim app As New Access.Application
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim nObjSelected As Long
Dim nObjLoaded As Long
Dim acObjType As Integer
Dim ObjPrefix As String
Dim objName As String
Dim ObjType As String
Dim ReturnDir As String
Dim fPrefix As Boolean

'Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = True
.Title = "Type of Objects to load"
.Filters.Clear
.Filters.Add "Text Files", "*.txt"
.Filters.Add "All Files", "*.*"
If .Show = True Then 'Show the dialog box.
Set app = CreateObject("Access.application")
app.OpenCurrentDatabase Me!txtDb
Dim pgbar As ProgressBar
Set pgbar = Me.ProgressBar9.Object
pgbar.Max = .SelectedItems.Count
pgbar.Scrolling = ccScrollingStandard
pgbar.Appearance = cc3D
pgbar.Min = 0
nObjSelected = 0
Screen.MousePointer = 11

Dim dblPct As Double

For Each varFile In .SelectedItems

Do Until nObjSelected > .SelectedItems.Count

dblPct = nObjSelected / .SelectedItems.Count
Me.txtPctComplete = dblPct
pgbar.Value = nObjSelected
DoEvents

objName = CreateObject("scripting.filesystemobject").GetBaseName(varFile)
ReturnDir = CreateObject("scripting.filesystemobject").GetParentFolderName(varFile) & "\"
If Left(objName, 6) = "Query_" Or Left(objName, 5) = "Form_" Or Left(objName, 7) = "Report_" Or Left(objName, 6) = "Macro_" Or Left(objName, 7) = "Module_" Then
ObjPrefix = InStr(objName, "_")
ObjType = Left(objName, ObjPrefix - 1)
Select Case ObjType
Case "Query"
acObjType = acQuery
Case "Form"
acObjType = acForm
Case "Report"
acObjType = acReport
Case "Macro"
acObjType = acMacro
Case "Module"
acObjType = acModule
End Select
app.LoadFromText acObjType, objName, varFile
Else
nObjLoaded = nObjLoaded + 1
End If
nObjSelected = nObjSelected + 1 'Count all objects.

Loop

Next varFile
app.Quit acQuitSaveNone 'Clean up.
Set app = Nothing

Screen.MousePointer = 1

If nObjSelected - nObjLoaded > 0 Then
ObjTypeFilter 'Refresh list.
MsgBox nObjSelected & " object(s) were selected." & vbCrLf _
& nObjSelected - nObjLoaded & " object(s) have been loaded." & vbCrLf & vbCrLf _
& "From: " & ReturnDir & vbCrLf _
& "To: " & Space(4) & Me!txtDb, vbOKOnly, "Load Complete"
Else
MsgBox "No object prefixes detected." & vbCrLf _
& "Query_" & vbCrLf _
& "Form_" & vbCrLf _
& "Report_" & vbCrLf _
& "Macro_" & vbCrLf _
& "Module_", vbOKOnly, "Objects as Text"
End If

pgbar = 0
Me!txtPctComplete.Value = "Ready"

End If
End With

Exit_Handler:
Exit Function

Err_Handler:
MsgBox Err.Description, vbOKOnly + vbExclamation, "ERROR: " & Err.Number
Resume Exit_Handler

End Function

I am not experienced in VBA, I am very much a beginner, muddling my way through and learning as I go a long. So if I have the Do loop all wrong I apologise now and ask you to post the code the way it should be written.

 
Why nested loop ?
I don't think you need a Do Until loop inside the For Each ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hello PHV

Thank you for your reply.

The Do Loop is for ProgressBar.
The For Loop loads the files.

I don’t know VBA, I’m learning, I thought I might have got it wrong.

Can you correct my code and post an example the way it should be. So the For Loop works and the ProgressBar works with it using whatever VBA it needs.

 
What happens if you get rid of the Do Until loop (keeping the inside code as is) ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hello PHV

Then the For Loop and rest of code works perfect, but with no ProgressBar of course because the Do Loop does that.
 
because the Do Loop does that
Really ?
I thought it was: pgbar.Value = nObjSelected
You have to get rid of only two lines:
1) Do Until nObjSelected > .SelectedItems.Count
2) Loop

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hello PHV

Sorry, its all very complicated to me.

I have just tried what you asked and the result is that the Progress Bar moves along but never completes. It seems to complete different amounts depending on the number of files selected but it never completes to the end.

When I select 1 file it doesn’t seem to move at all.
When I select 2 files it seems to move to about half way and then stops.
When I select 14 files (which in this case was all there was) it moved nearly all the way across and then stoped.
 
Hello PHV

I forgot to mention that the rest of the code (For Loop etc) all worked perfectly OK.

 
>When I select 1 file it doesn’t seem to move at all.
>When I select 2 files it seems to move to about half way and then stops.
>When I select 14 files (which in this case was all there was) it moved nearly all the way across and then stoped.

Think hard about what you have observed.
Consider that you are incrementing nObjSelected at the end of the For Next loop

See if you can spot a link between your obervations, and that latter fact.
 
Simply replace this:
nObjSelected = 0
with this:
nObjSelected = 1

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hello PHV

Unbelievable.

Something that seemed to confuse me no end, and yet I was so close, I had no idea. I’ve been tinkering with it for days.

I guess its all in the knowing.

Thank you very much for sticking with me and for replying to my thread in the first place, and of course for sorting it out for me.

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top