[AccessD] Running a Dir command from within Access vba

jack drawbridge jackandpat.d at gmail.com
Mon Mar 13 10:25:58 CDT 2017


Thanks Stuart.

Adapting it now.

jack

On Mon, Mar 13, 2017 at 8:40 AM, Stuart McLachlan <stuart at lexacorp.com.pg>
wrote:

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


More information about the AccessD mailing list