List of all files in subdirectories append to table

[renovator]

Hi,
I am new to VBA and Access and I am way over my head.
The problem is to create a table (tblFIles) listing all files in a subdirectory and append to the main table (tblMainFIles) if they don't already exist based on non primary keys and then update an audit trail with the changes
eg

1/ if there is a match on file name and creation date and folder is different then update the folder. But all the stuff I have read is that duplicates are only stopped by primary keys for appends
2/ if there is is no match on file name, creation date and folder then add to the tblMainFiles
and a lot more like that
3/add the change to an audit file

So I am currently google coding
This lists all files in a sub directory
allenbrowne . com /ser-59. html
This lists files in one directory and creates a file
devhut .net / getfilelistandspecs/

but I don't know how to put them together

tblAudit Audit Trail

FileId - autonumber
ChangeDate - date
Field - string
OldValue - can be a string or a date
NewValue -can be a string or a date

tblMainFIles and tblFiles ( both have the same format)

FileID - autmnumber
FileName - short text
Filesize - number
FileDateCreated- date/time
FileDateLastModified- date/time
FileDateLastAccessed - date/time
FileType - short text
FileAttributes - short text
FileParentFolder - short text
FileFullPath - short text
FileFlag - short text

regards R

 

[static]

You might find it easier (but less efficient) to add all of the files to a temp table and use queries to run the updates.

i.e.
one query to delete files where the names and dates match - no changes.
another query to record files where the names match but the dates and file sizes don't.
another that records newly added files.
another that records files that have been deleted.
etc

 

[The_Doc_Man]

Concur with Static. "Divide and Conquer" is an excellent strategy for ANY programming exercise that contains varying actions and varying criteria.

If you use a "Temp" table approach, you just erase it, run your discovery of files, and then run your tests one record at a time. Add a couple of flags or perhaps a single "action" field to the Temp record so that you can remember whether to delete, add, etc.
and then step through that recordset as many times as needed to fully identify each file, determine what action is needed, take the action, LOG the action, clean up the mess afterwards. There might be more elegant solutions, but you claim to be a bit over your head right now.

If that is so, then make it a multi-pass algorithm where you open the Temp table as a recordset and sweep through it one record at a time for testing (and mark the choice). Then return to the front of the recordset and sweep through a second time to actually take action. Then (if logging is required) do a third sweep.

Normally I wouldn't do it this way, but if you are having issues with putting it all together, ... don't. Just do it in increments. Later on as you gain experience, you will see how to make it all work in one pass. But hey, all of LIFE is a learning experience. So grin and get ready to learn!

 

[renovator]

Hi,
Thank-you for your advice and I am dividing and conquering
Ok the first step is
1. "If you use a "Temp" table approach, you just erase it, run your discovery of files,"
i/ I have modified the code and created the file, I jneed to know how to find the "my documents" directory so I can set the strPath variable to C:\...\
My documents
ii/ when I run it over large directory structure the first 65206 records are not saved

FileID - auto
FName - short test 50 limit
FPath - short text  255 limit
Date Created

Option Compare Database
Option Explicit

'list files to tables

'to test use immediate window
'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)

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
      
    gCount = 0 'renovator
      
   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 removed by renovator
    
    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
    
    'added by Renovator
    Dim db  As DAO.Database 'renovator
    Set db = CurrentDb() 'renovator
    db.Execute "Delete * FROM Files", dbFailOnError    'Wipe previous records
    
    '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