Revisit pulling in Files from Directory. File quantity question

[aquabp]

I am using this code from allen brown to pull in files from a directory to an access table. I posted earlier and with help from the group I was able to add code to pull in file size and file creation date.



The lines with the confused emoji out in front are the lines I have added. Here is the issue. When I do not have these lines in the code, the code pulls over 30,000 file names. With these code lines added the code only pulls in a little over 4000 files. I have compared the two tables. Those file names that do not match are real files. I am not a programmer. When I add the lines in one at a time the issues start to occur at the line Dim FDate as date or the line FDate = FileDateTime(strFolder & strTemp)

Can someone explain why this is happening and what I need to do to fix it?

Also, I used the emoji because I could not find out how to highlight. Can we highlight and if so how do I do that?

Thanks

Option Compare Database
Option Explicit
 
 
'list files to tables include File Size, creation date, and path to file.
'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 _
    , strSQL As String
   
    strPath = "E:\"
    strFileSpec = "*.*"
    booIncludeSubfolders = True
   
    strSQL = "Delete * from Files;"
    CurrentDb.Execute strSQL
    gCount = 0
   
    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 _
    )
    CurrentDb.Execute "Delete * From files", dbFailOnError
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
    Dim FDate As Date
   
    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
   
    Do While strTemp <> vbNullString
         gCount = gCount + 1
         SysCmd acSysCmdSetStatus, gCount
         FDate = FileDateTime(strFolder & strTemp)
        strSQL = "INSERT INTO Files " _
            & " (FName, FPath, FDate, FSize) " _
            & " SELECT '" & strTemp _
            & "', '" & strFolder _
            & "', #" & FDate & "#" _
            & ", """ & FileLen(strFolder & strTemp) & """;"
 
         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

[June7]

Highlighting: select text and click the FontColor button from the editing toolbar.

I doubt variable declarations are causing issue. It's how they are set and used that is issue.

You need to learn how to debug code. Set a breakpoint and follow code one line at a time. Check that it flows as expected and variables are correctly set. See link at bottom of my post for debugging guidelines.

Too much code to try following logic in my head. I don't want to build/modify a db to handle your code nor modify code to run with my db. If you want to provide db for analysis, follow instructions at bottom of my post.

Exactly what is the issue? What is the error? You want 30,000 files? Then why did you add the code that limits to 4,000? How are 2 tables involved?

[aquabp]

GLEFC.zip

Ok, I have highlighted the added code in Post 1. I have also attached the database above. Code is in Module 1 called from 01_MasterF06 form. You will need to edit the directory it is pulling from. If the directory had multiple sub directories that would be great. Not too large, 30,000 files takes about 5 minutes to pull.


I have read the file you suggested and tried to put the cursor on the first line of code or any line of code and hit f8 to start the line by line review but nothing happened. I usually hit the compile database option on the debug menu. Will keep trying to figure this out.

Thanks

[June7]

You have to set breakpoint(s) then run the procedure as you normally would - button click or whatever. You can set and unset breakpoints as you step through the code. Can set a breakpoint farther down the code and click Run. Keep doing that as you watch the progress.

My first attempt saved 31,666 records in about a minute. No problems.

Please clarify the issue you are having.

That light blue highlight is hard to read. Red is better.

[aquabp]

Hi June7,

woaddedcode.zip

Highlighted code changed to red.

Clarification of issue. The code pulled 30,000 records before the highlighted code was added. After adding the highlighted code it only pulled 4000 records. The issue is that there are 26,000 records not being pulled when I add highlighted code.

Attached is code with the highlighted code removed.

[ssanfu]

OK, I spent way too many hours on this but I wasn't about to let it beat me.

I modified your code ... well look at the add files tab. I couldn't get the text box control to be updated with the number of files found..... the problem was that the first character of the form name was a number instead of a letter. I renamed the form "00_WWFCF00" to "A00_WWFCF00" and, poof, no errors.

It is really not a good idea to begin names with numbers.

Have a look..... trace the code.

[aquabp]

"Veni, Vidi,hui!"
I came; I saw; wow!"

Nicely done!! You just answered the question that thousands of people have been asking for years from what I can see in the net!! You modified Allen Brown's code and provided information about the file. More then I asked for!!

Thank you very much for all your work! I am going to start calling you Master Ssanfu!!