Mkdir to make multile folders from a query

[Carouser]

I am creating a Presentation db and require a coding solution to batch create folders. My Access level is between hack and mediocre. I have already created the paths in a query which I use for hyperlinking on a user form to go to a particular directory based on session information entered for each presenter. There are 3 levels of folders apart from the main folder. 1. Day, 2.Sessions, 3. Rooms of which there are multiple combinations. I have looked and found a few examples, but do not know how to get my query field source into a public function. I just want one button to press and have instantaneous directories.


Below is some code I would like to try, but I don't know how to progress to parse my query to it.

http://www.devhut.net/2011/09/15/vba...e-directories/

Public Sub MyMkDir(sPath As String) Dim iStart As Integer Dim aDirs As Variant Dim sCurDir As String Dim i As Integer If sPath <> "" Then aDirs = Split(sPath, "\") If Left(sPath, 2) = "\\" Then iStart = 3 Else iStart = 1 End If sCurDir = Left(sPath, InStr(iStart, sPath, "\")) For i = iStart To UBound(aDirs) sCurDir = sCurDir & aDirs(i) & "\" If Dir(sCurDir, vbDirectory) = vbNullString Then MkDir sCurDir End If Next i End If End Sub



Any guidance would be appreciated

[Rod]

I have not tested this!

Public Sub MyMkDir(rstrQueryName As String, rstrFieldName As String)
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef
    Dim fld As Field
    Dim strFullPath As String
    Dim strPartPath As String
    Dim strDir() As String
    Dim i As Integer
    
    Set qdf = CurrentDb.QueryDefs(rstrQueryName)
    For Each fld In qdf.Fields
        If fld.Name = rstrFieldName Then GoTo MyMkDirContinue
    Next
    Exit Sub
    
MyMkDirContinue:
    
    Set rst = CurrentDb.OpenRecordset(rstrQueryName)
    With rst
        Do Until .EOF
            strFullPath = fld.Value
            GoSub MakeDirectories
            .MoveNext
        Loop
    End With
    Exit Sub
    
MakeDirectories:
    strPartPath = ""
    strDir = Split(strFullPath, "\")
    strPartPath = strDir(0)
    For i = 1 To UBound(strDir) - 1
        strPartPath = strPartPath & "\" & strDir(i)
        If Len(Dir(strPartPath)) = 0 Then
            MkDir strPartPath
        End If
    Next
    Return
End Sub

Judging by your post I think you know enough to review this and make changes as per your needs - especially for trapping situations where the query or field names do not exist. It assumes the last term in the full path is a file and does not attempt to create a directory for this.

[R_Badger]

I can think of a way, but it is a little convoluted so bear with me.

Insert your public sub in a module (remember not to name the two the same)

I would create your initial button on a form, and have a simple command behind that.

docmd.openform "Frm_dir_maker", , , , achidden

Create the new form and set the recordsource to be your query.

Then in the new forms open event you want something along the lines of:

dim qty as integer
dim x as integer
qty=dcount("[fullpath]","[qryfullpath]")
for x=1 to qty
docmd.gotorecord , , acgoto, x
mkdir([fullpath])
next
docmd.close

give it a try no promises as always, but if you have a problem, shout and hopefully by then i will have woken up a little!

[Rod]

R_B

MkDir fails if an intermediate directory is missing. Thus MkDir "C:\Users\Rod\Archive\Scans" fails if C:\Users\Rod\Archive does not exist.

As you can read, I have not tested my suggestion (which is even more convoluted than yours). However I'm fairly certain that MkDir is a sub procedure and not a function so the argument does not need parentheses.

Hey ho!

[R_Badger]

seems we were both going for it at once!

Yes it is indeed true now I've had a coffee I've had another look, yours should work, whereas all mine would return with is a lovely set of errors!

[Carouser]

Ok, so looks like Rod's code is the go, but I'm still not sure how to set up a form with the query and the magic 'go' button. R_Badger's method seemed to touch on a methodology of calling in the procedure.

Is it as basic as a button with "Call MyMkDir". Do I need to specify the field names in the code above?

[Rod]

Carouser,

It seems from the picture in your first post that you have the query - it's called qryFullPath?

You also have a form - is it frmSPKSF?

In design view for your form, add a command button. Select that command button. In the properties sheet double click alongside the 'Click' event and then on the '...' (elipsis). This should take you to the VBA coding window inside a procedure named something like Private Sub btnCreateDirectories_Click.

Type MyMkDir "qryFullPath", "FullPath" inside the procedure. (Use your own names for the query and column if I have got them wrong. (No need for a 'Call' keyword.)

Now copy and paste my code into the VBA module. Click Debug (on the menu) and Compile to check for obvious errors.

Now return to your form in form view and test the button.

I'm not as confident that it will work first time as R_B is. Meanwhile I'll see if I can rig up a test db for it.

[Carouser]

Ok, I have followed your instructions. I have copied your code into a new module and renamed it MyMkdir2. Attached is the compile error. I already have the Presentations folder created, should I just use the next level path?

[Rod]

Let me preempt the cries of protest that it does not work. There are two changes to be made to my code highlighted in red in the following. After that, it works for me.

Public Sub MyMkDir(rstrQueryName As String, rstrFieldName As String)
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef
    Dim fld As Field
    Dim strFullPath As String
    Dim strPartPath As String
    Dim strDir() As String
    Dim i As Integer
    
    Set qdf = CurrentDb.QueryDefs(rstrQueryName)
    For Each fld In qdf.Fields
        If fld.Name = rstrFieldName Then GoTo MyMkDirContinue
    Next
    Exit Sub
    
MyMkDirContinue:
    
    Set rst = CurrentDb.OpenRecordset(rstrQueryName)
    With rst
        Do Until .EOF
            strFullPath = .Fields(fld.Name).Value
            GoSub MakeDirectories
            .MoveNext
        Loop
    End With
    Exit Sub
    
MakeDirectories:
    strPartPath = ""
    strDir = Split(strFullPath, "\")
    strPartPath = strDir(0)
    For i = 1 To UBound(strDir) - 1
        strPartPath = strPartPath & "\" & strDir(i)
        If Len(Dir(strPartPath, vbDirectory)) = 0 Then
            MkDir (strPartPath)
        End If
    Next
    Return
End Sub

[Carouser]

It took me a while to figure out that the files had already been created because it is so quick and stealth like. The last level of folders are not being created though. I tried the combinations of just C:Pres\days\sessions and just the Pres & Day folders are created.

Rod, I appreciate all the time and effort you have given me. I am still dissecting your code to better understand the workings of VBA and how you made it work.

[Rod]

It assumes the last term in the full path is a file and does not attempt to create a directory for this.

OK, find the following statement

For i = 1 To UBound(strDir) - 1

and remove the minus one to make it

For i = 1 To UBound(strDir)

[Carouser]

Perfect!!!!!

Automating a tedious task that I would have to do manually is fantastic. This db Template has be portable and is only used for the life of one conference as there will always be a new set of presenters, times and rooms in different venues, so it is essential to have a quick method of creating folders. There are a few other things I am looking at doing, and will start a new thread if I fail to do it myself first.

Thanks again Rod

Cheers

-I can't seem to locate the solved Icon