[AccessD] Running a Dir command from within Access vba

[jack drawbridge]

Thanks for the code Lambert.
I'm putting in my "vba file" for reference.

/jack

On Mon, Mar 13, 2017 at 10:36 AM, Heenan, Lambert <Lambert.Heenan at aig.com>
wrote:

> 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
>
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>