VBA Loop through form (1 Viewer)

[dgaller]

I am working on making folders for each crate in a table. I made a datasheet for and put the below code. However I continue to get a "Loop without DO" error.

Can anyone assist with what I have done wrong?

Dim rs As DAO.Recordset
Dim strSQL As String
Dim strBookmark As String
Set rs = Me.RecordsetClone

rs.MoveFirst

strBookmark = rs.Bookmark
Do While Not rs.EOF


Dim DirName As String
Dim DirName2 As String
Dim Response As String



DirName2 = "C:\Project_Photos\" & [Forms]![Makedirform]![Crate UID]
DirName = "C:\Project_Photos\" & [Forms]![Makedirform]![Crate UID] & "\" & [Forms]![Makedirform]![Internal Package UID]

Set rs = Me.RecordsetClone

rs.MoveFirst

strBookmark = rs.Bookmark
Do Until rs.EOF

If Dir(DirName2, vbDirectory) = "" Then
MkDir DirName2
End If

If IsNull([Forms]![Makedirform]![Internal Package UID]) Then
rs.MoveNext
Loop

rs.Close
Me.Bookmark = strBookmark


Else
If Dir(DirName, vbDirectory) = "" Then
MkDir DirName

End If
rs.MoveNext
Loop

rs.Close
Me.Bookmark = strBookmark


Exit_Folder_with_Store:
Exit Sub

Err_Folder_with_Store:
MsgBox Err.Description
Resume Exit_Folder_with_Store





End Sub

 

[mdlueck]

You have intermixed If/Then/Else statements intertwined in your two Do/Loop's.

My head aches right off trying to discern what your code is intended to do. I agree with the VBA interpreter in this case.

You need to perhaps use pen and paper, draw out your two logical loops, then inside the correct loop use your If/Then/Else and do NOT split it with a loop.

 

[dgaller]

Sorry for the head ache.

I am by no means an expert. What I am attempting to do is loop through a form creating folders and in some cases sub folders if they don't already exist.

I tried to make the code as straight forward as possible below.

Dim DirName As String
Dim DirName2 As String
Dim Response As String
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strBookmark As String

DirName2 = "C:\Project_Photos\" & [Forms]![Makedirform]![Crate UID]
DirName = "C:\Project_Photos\" & [Forms]![Makedirform]![Crate UID] & "\" & [Forms]![Makedirform]![Internal Package UID]

Set rs = Me.RecordsetClone

rs.MoveFirst

strBookmark = rs.Bookmark
Do While Not rs.EOF

If Dir(DirName2, vbDirectory) = "" Then
MkDir DirName2
End If

If IsNull([Forms]![Makedirform]![Internal Package UID]) And Dir(DirName2, vbDirectory) = "" Then
MkDir DirName2
rs.MoveNext
Loop

rs.Close
Me.Bookmark = strBookmark

 

[mdlueck]

I tried to make the code as straight forward as possible below.

That looks much better. So what does that version still not do that you desire it to? Or does it still not work / not compile?

 

[dgaller]

It won't compile. I get an error that there is a loop with out a do?

 

[Pat Hartman]

I don't see any references to fields of the rs from within the loop. What are you expecting to change?

 

[ChrisO]

There was no End If for this line:-
If IsNull([Forms]![Makedirform]![Internal Package UID]) And Dir(DirName2, vbDirectory) = "" Then

This appears to be the logic of what is required.
MakeSureDirectoryPathExists will create multiple directories in one hit and it does not interfere with directories which already exist.

Private Declare Function apiCreatePath Lib "Imagehlp.dll" _
                  Alias "MakeSureDirectoryPathExists" (ByVal strPath As String) As Long


Private Sub cmdMakeDirectories_Click()
    Dim strDirectory As String
    
    With Me.RecordsetClone
        If .RecordCount Then
            .MoveFirst
            
            Do Until .EOF
                Me.Bookmark = .Bookmark
                strDirectory = vbNullString
                
                If Len(Me.[Crate UID]) Then
                    strDirectory = "C:\Project_Photos\" & Me.[Crate UID] & "\"
                    
                    If Len(Me.[Internal Package UID]) Then
                        strDirectory = strDirectory & Me.[Internal Package UID] & "\"
                    End If
                End If
                
                If Len(strDirectory) Then apiCreatePath strDirectory
            
                .MoveNext
            Loop
        End If
    End With
    
End Sub

Chris.

 

[dgaller]

Perfect, thanks to all who helped.