[AccessD] Running a Dir command from within Access vba

[Stuart McLachlan]

I've got several Access applications which do a recursive directory search and them 
manipulate the files.   This should give you a file containing a list of all the .jpg files in all the 
sub directories below the start directory  (In this case, the start directory is the one containing 
the Access file, but you can change this by starting somehere other than 
CurrentProject.Path):


Private gStrDirectories() As String
Private gDirCount as long

Function GetAllFiles() As Long
Dim l As Long
On Error Resume Next
Kill CurrentProject.Path & "\FileList.txt"
On Error GoTo 0
'First fill the global array with all of the sub-directories
RecurseDir (CurrentProject.Path & "\*.*") 
'Now get all of the desired files in the sub-directories
For l = 1 To UBound(gStrDirectories())
    GetJPGs (gStrDirectories(l))
Next
End Function

Function RecurseDir(strDirSpec As String) As Long

    Dim llngOnce As Long
    Dim llngEndSubscript As Long
    Dim llngStartSubscript As Long
    Dim strFolder As String
    Dim strFileName As String
    Dim llngCounter As Long
    Dim llngAttribute As Long
    Dim gLngPointers() As Long


    ' llngOnce = tag if dirs present
    ' llngEndSubscript = ending pointer
    ' llngStartSubscript = pointer to first position in array
    
     strFolder = Left$(strDirSpec, Len(strDirSpec) - 3)

         ' step 1 - make a list of all the dirs in this folder
    ' and append them to the global array
    ' and remember the starting point where this
    ' list begins
    strFileName = Dir$(strDirSpec, vbDirectory)
    Do While Len(strFileName)
        llngAttribute = GetAttr(strFolder & "\" & strFileName)
        If (llngAttribute = vbDirectory) And Right$(strFileName, 1) <> "." Then  'it's a dir
            gDirCount = gDirCount + 1

            'tried redim preserve every 100 iterations etc but no speed increase
            ReDim Preserve gStrDirectories(gDirCount)
            ReDim Preserve gLngPointers(gDirCount)
            gStrDirectories(gDirCount) = strFolder + strFileName
            If llngOnce = 0 Then
                llngOnce = 1
                llngStartSubscript = gDirCount ' pointer to first entry in this list
            End If
        End If

        strFileName = Dir$
    Loop

        ' step 2 - if no dirs were found return 0 as the pointer value

    If llngOnce = 0 Then
        RecurseDir = 0
        Exit Function
    End If

    ' step 3 - let's back up to where we started locally and moving forward
    ' until we reach the local end, call this function recursively,
    ' tagging each pointer with the starting point in the global array that
    ' contains the child folders.
    llngEndSubscript = gDirCount ' gDirCount is global and will change

    For llngCounter = llngStartSubscript To llngEndSubscript
        gLngPointers(llngCounter) = RecurseDir(gStrDirectories(llngCounter) + "\*.*")
    Next llngCounter

    ' Step 4, - return the pointer to the start of the list we just made
    RecurseDir = llngStartSubscript
End Function

Function GetJPGs(strDir As String) As String
Dim strF As String
    strF = Dir$(strDir & "\*.jpg")
    While strF > " "
      Open CurrentProject.Path & "\FileList.txt" For Append As #1
      Print #1, strF
      Close #1
      strF = Dir$
    Wend
End Function







On 12 Mar 2017 at 13:58, jack drawbridge wrote:

> Thanks Rocky.
> I've been googling and now think I need a bat file.
> 
> I have to change Directories, run the Dir with parameters and then
> output the result to a file.
>