Populate a Table from VBA code

Question

This seems like a really simple, given thing, but I can't quite figure it out... I have a VBA code created just as a Module that creates a list of files for me. I can run it in the Immediate window and it works great. How do I get those results into a Table where I can actually use the information? I already have a table setup with matching fields, I just don't know how to connect the two.

And how do I make it run? I'm thinking put the Call command that I use in the Immediate window in an "OnLoad" code?

Full code below if it helps...

Public Sub listFiles(startFolder As String, Optional recurse As Boolean = True) 

On Error GoTo ErrorHappened 

    Dim fso, folder, file, subfolder 

    Set fso = CreateObject("Scripting.FileSystemObject") 

    If LenB(startFolder) = 0 Then Exit Sub 

    If Right(startFolder, 1) <> "\" Then startFolder = startFolder & "\" 

    Set folder = fso.GetFolder(startFolder) 

    For Each file In folder.files 

        If fso.GetExtensionName(file.Path) <> "bak" And fso.GetExtensionName(file.Path) <> "ps1" Then 

            Debug.Print file.Name, file.Path, file.DateLastModified, file.DateCreated 

        End If 

    Next 

    If recurse Then 

        For Each subfolder In folder.SubFolders 

            listFiles subfolder.Path, recurse 

        Next 

    End If 

ExitNow: 

    On Error Resume Next 

    Set fso = Nothing 

    Set folder = Nothing 

    Set file = Nothing 

    Set subfolder = Nothing 

    Exit Sub 

ErrorHappened: 

    MsgBox "Error " & Err.Number & " (" & Err.Description & ")" 

    Resume ExitNow 

End Sub

Answer 1

One option would be to clear the table at the beginning of the code:

CurrentDb.Execute "DELETE \* FROM MyTable", dbFailOnError

where MyTable is the name of the table.

Another option is to check in the code:

Public Sub listFiles(startFolder As String, Optional recurse As Boolean = True)
Dim fso, folder, file, subfolder
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

If LenB(startFolder) = 0 Then Exit Sub  
  
On Error GoTo ErrorHappened  
  
Set dbs = CurrentDb  
Set rst = dbs.OpenRecordset("MyTable", dbOpenDynaset)  
  
If Right(startFolder, 1) <> "\" Then startFolder = startFolder & "\"  
  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder(startFolder)  
For Each file In folder.Files  
    If fso.GetExtensionName(file.Path) <> "bak" And fso.GetExtensionName(file.Path) <> "ps1" Then  
        If DCount("\*", "MyTable", "FilePath='" & file.Path & "' AND FileName='" & file.Name & "'") = 0 Then  
            rst.AddNew  
            rst!FileName = file.Name  
            rst!FilePath = file.Path  
            rst!DateLastModified = file.DateLastModified  
            rst!DateCreated = file.DateCreated  
            rst.Update  
        End If  
    End If  
Next file  
If recurse Then  
    For Each subfolder In folder.SubFolders  
        listFiles subfolder.Path, recurse  
    Next subfolder  
End If  
  

ExitNow:
On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set fso = Nothing
Set folder = Nothing
Set file = Nothing
Set subfolder = Nothing
Exit Sub

ErrorHappened:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Resume ExitNow
End Sub

Answer 2

Ok, so on first try, this works great. However, when I run it again, it adds all the same files again, creating duplicates. Is there a way I can just append new files to my list?

Answer 3

Here is a modified version. Change the name of the table and of the four fields as needed.

Public Sub listFiles(startFolder As String, Optional recurse As Boolean = True)
Dim fso, folder, file, subfolder
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

If LenB(startFolder) = 0 Then Exit Sub  
  
On Error GoTo ErrorHappened  
  
Set dbs = CurrentDb  
Set rst = dbs.OpenRecordset("MyTable", dbOpenDynaset)  
  
If Right(startFolder, 1) <> "\" Then startFolder = startFolder & "\"  
  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder(startFolder)  
For Each file In folder.Files  
    If fso.GetExtensionName(file.Path) <> "bak" And fso.GetExtensionName(file.Path) <> "ps1" Then  
        rst.AddNew  
        rst!FileName = file.Name  
        rst!FilePath = file.Path  
        rst!DateLastModified = file.DateLastModified  
        rst!DateCreated = file.DateCreated  
        rst.Update  
    End If  
Next file  
If recurse Then  
    For Each subfolder In folder.SubFolders  
        listFiles subfolder.Path, recurse  
    Next subfolder  
End If  
  

ExitNow:
On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set fso = Nothing
Set folder = Nothing
Set file = Nothing
Set subfolder = Nothing
Exit Sub

ErrorHappened:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
Resume ExitNow
End Sub

Answer 4

I would do this with an append query. Add this to the code AFTER your Debug.Print line

CurrentDB.Execute "INSERT INTO tblYourTableNameGoesHere (FileName, FilePath, FileDateLastModified, FileDateCreated " & _

"SELECT '" & file.Name & "', '" & file.Path & "', '" & file.DateLastModified & "', '" & file.DateCreated & "'", DBFailOnError

Change the table and field names to those in your actual database.

Answer 5

You could create a recordset. For example:

Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("TableName")

...

For Each file...

If fso.GetExtensionName...

    Debug.Print...

    rs.AddNew

    rs!FileName=file.Name

    rs!FilePath=file.Path

    etc...

    rs.Update

End If

....

rs.Close

Set rs = Nothing

Hope that helps...