[AccessD] Running a Dir command from within Access vba

[Heenan, Lambert]

I use a similar approach to doing a recursive directory search, but instead of writing the file names to a text file I return them to the caller in a Collection. This is a modification of some code from Albert Kallall, in turn adapting Allen Browne...

Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles

    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    End If

    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If
End Function



Lambert  
-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Stuart McLachlan
Sent: Monday, March 13, 2017 8:40 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Running a Dir command from within Access vba

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.
> 

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com