how do i import a directory file list into an access table

[Guest]

I am creating backup dvd's of folders and want to find a way to get a
directory strcuture into an access table with minimal pain. then I can query
on date folder filename etc.

Help. A newbe here.

 

[John Nurick]

Open a Command Prompt (MS-DOS Prompt) and havigate to the starting point
of the folder structure you're interested in (using the CD command and
drive letters).

Then run the command
DIR *.* /D /S /B
which will list the paths to all folders below the starting point.

Once you're satisfied with it, add a redirection clause to send the
command output to a text file, e.g.
DIR *.* /D /S /B > "C:\Temp\List of folders.txt"

You can then import the list from the text file into an Access table
where you can filter and parse it as required.


On Thu, 31 Mar 2005 12:29:02 -0800, "CAD Geek" <CAD

 

[Joe Fallon]

How to Add Directory File Names to an Access Table:

Create a table named tblDirectory with 2 fields:
FileName (Text 250)
FileDate (Date/Time)

Call the code below by pressing Ctrl-G to open the debug window and type:
GetFiles("c:\windows\")

Paste this code into a regular module:

Sub GetFiles(strPath As String)
Dim rs As Recordset
Dim strFile As String, strDate As Date

'clear out existing data
CurrentDb.Execute "Delete * From tblDirectory", dbFailOnError

'open a recordset
Set rs = CurrentDb.OpenRecordset("tblDirectory", dbOpenDynaset)

'get the first filename
strFile = Dir(strPath, vbNormal)
'Loop through the balance of files
Do
'check to see if you have a filename
If strFile = "" Then
GoTo ExitHere
End If
strDate = FileDateTime(strPath & strFile)
rs.AddNew
'to save the full path using strPath & strFile
'save only the filename
rs!FileName = strFile
rs!FileDate = strDate
rs.Update

'try for next filename
strFile = Dir()
Loop

ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Sub

 

[RhythmPlynth]

Many thanks for that Joe.. your post helped me find the answer I was looking for.. changed your code slightly to do what I wanted.. (Folders and Files listing) though it was a little like a monkey at a typewriter at first .

Have cracked SQL &, cascading combo boxes in the past few months and now the VBA is starting to get easier thanks to good examples available, like the above.

Edit: obviously had to add a new field to tblDirectory called FolderName

Sub GetFolders(strPath As String)
Dim rs As Recordset
Dim strDate As Date, strFolder As String 'strFile As String

'clear out existing data
CurrentDb.Execute "Delete * From tblDirectory", dbFailOnError

'open a recordset
Set rs = CurrentDb.OpenRecordset("tblDirectory", dbOpenDynaset)

'get the first filename
strFolder = dir(strPath, vbDirectory)
'strFile = dir(strPath, vbNormal)

'Loop through the balance of files
Do
'check to see if you have a filename
If strFolder = "" Then
GoTo ExitHere
End If
'strDate = FileDateTime(strPath & strFolder)

rs.AddNew
'to save the full path using strPath & strFile
'save only the filename
'rs!FileName = strFile
'rs!FileDate = strDate
rs!Foldername = strFolder
rs.Update

'try for next filename

strFolder = dir()


Loop

ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Sub

 

[RhythmPlynth]

Well that didn't work as I thought. It works with GetFolders("D:/") but if a sub folder is used in the argument then tblDirectory lists only one record, the folder queried.

What I really want is a table listing every sub folder and a subdatasheet for every folder listing all files/dates. If a sub folder contains more subfolders these would need to be added as a new record in tblDirectory.. if that makes sense.. I think this is currently out of my reach.. anyone any thoughts?

 

[RhythmPlynth]

http://www.everythingaccess.com/tutorials.asp?ID=List-files-to-a-table

found the above/below, from Allen Browne.. nice.

To list the files in C:\Data, open the Immediate Window (Ctrl+G), and enter:
Call ListFilesToTable("C:\Data")

To limit the results to zip files:
Call ListFilesToTable("C:\Data", "*.zip")

To include files in subdirectories as well:
Call ListFilesToTable("C:\Data", , True)

Option Compare Database
Option Explicit

'list files to tables
'http://allenbrowne.com/ser-59alt.html

Dim gCount As Long ' added by Crystal

Sub runListFiles()
    'Usage example.
    Dim strPath As String _
    , strFileSpec As String _
    , booIncludeSubfolders As Boolean
    
    strPath = "E:\"
    strFileSpec = "*.*"
    booIncludeSubfolders = True
    
    ListFilesToTable strPath, strFileSpec, booIncludeSubfolders
End Sub

'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable(strPath As String _
    , Optional strFileSpec As String = "*.*" _
    , Optional bIncludeSubfolders As Boolean _
    )
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    
    Dim colDirList As New Collection
    Dim varitem As Variant
    Dim rst As DAO.Recordset
    
   Dim mStartTime As Date _
      , mSeconds As Long _
      , mMin As Long _
      , mMsg As String
      
   mStartTime = Now()
   '--------
    
    Call FillDirToTable(colDirList, strPath, strFileSpec, bIncludeSubfolders)
      
   mSeconds = DateDiff("s", mStartTime, Now())
   
   mMin = mSeconds \ 60
   If mMin > 0 Then
      mMsg = mMin & " min "
      mSeconds = mSeconds - (mMin * 60)
   Else
      mMsg = ""
   End If
   
   mMsg = mMsg & mSeconds & " seconds"
   
   MsgBox "Done adding " & format(gCount, "#,##0") & " files from " & strPath _
      & IIf(Len(Trim(strFileSpec)) > 0, " for file specification --> " & strFileSpec, "") _
      & vbCrLf & vbCrLf & mMsg, , "Done"
  
Exit_Handler:
   SysCmd acSysCmdClearStatus
   '--------
    
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , "ERROR"
    
    'remove next line after debugged -- added by Crystal
    Stop: Resume 'added by Crystal
    
    Resume Exit_Handler
End Function

Private Function FillDirToTable(colDirList As Collection _
    , ByVal strFolder As String _
    , strFileSpec As String _
    , bIncludeSubfolders As Boolean)
   
    'Build up a list of files, and then add add to this list, any additional folders
    On Error GoTo Err_Handler
    
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    Dim strSQL As String

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
         gCount = gCount + 1
         SysCmd acSysCmdSetStatus, gCount
         strSQL = "INSERT INTO Files " _
          & " (FName, FPath) " _
          & " SELECT """ & strTemp & """" _
          & ", """ & strFolder & """;"
         CurrentDb.Execute strSQL
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        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 function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If

Exit_Handler:
    
    Exit Function

Err_Handler:
    strSQL = "INSERT INTO Files " _
    & " (FName, FPath) " _
    & " SELECT ""  ~~~ ERROR ~~~""" _
    & ", """ & strFolder & """;"
    CurrentDb.Execute strSQL
    
    Resume Exit_Handler
End Function

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

 

[Nicholas Visco]

I hope someone can help with a quick fix... I'm not a real programming guy, just doing some things to make work easier. So although I can read and understand VB code, and have experience with MS Access, some things are way over my understanding, as follows: I used some of the sample code above and thought I got it right to accomplish something like the original poster, but when the code runs to the statement Set rs = CurrentDb.OpenRecordset("DocLibIndex", dbOpenDynaset) I get a "Run time error 3001 Invalid Argument" error. I've searched for a similar problem and solution but am not seeing anything that helped so far. Can anyone throw me a suggestion? Thanks in advance.

Option Compare Database
Function GetFiles(strPath As String)
Dim rs As Recordset
'Dim strFile As String, numKey As Double
Dim strFile As String, numKey As String

'strPath = "\Documents\" 'over-rides the path argument

'clear out existing data
CurrentDb.Execute "Delete * From DocLibIndex", dbFailOnError

'open a recordset
Set rs = CurrentDb.OpenRecordset("DocLibIndex", dbOpenDynaset)
'alternate...   Set dbs = CurrentDb
'               Set rs = dbs.OpenRecordset(DocLibIndex, dbOpenDynaset)

'get the first filename
strFile = Dir(strPath, vbNormal)

'Loop through the balance of files
Do
    'check to see if you have a filename
    If strFile = "" Then
        GoTo ExitHere
    End If
   
    numKey = strFile
   
    rs.AddNew
    'to save the full path using strPath & strFile
    'save only the filename
    rs!FileName = strFile
    rs!DocKey = numKey
    rs.Update
   
    'try for next filename
    strFile = Dir()
Loop

ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function

 

[Nicholas Visco]

Solved the problem... I needed to add the DAO library which I was unfamiliar with (found more specifics about where to do that on another post... in case anyone else is a newbie like me in the VBA modules window go to Tools - References)