Creating a table from files in a folder

It appears to me that the example you sent is like a utility that can be used on a lot of folders containing PDF, pictures and audio files.
The first sections deal with setting up the filepicker and getting the folder to be examined. For my proposes I need to get the file name and properties from a specific folder, every time, and that folder contains audio files in .m4a format. I have copied parts of the example that I think have what I am looking for. (Correct me if I am wrong.) I am guessing that the part I need to use is the last section of code below:
Sub AddFilesToTable. The Last line of the top bit of code calls/branches to AddFilesToTable routine. (Is that correct?) and that's the routine that builds the table. I need to know if that last section can stand alone, and if not, what do I have to change to make it so?

Lastly, for now, I would like to constrain the output to only files that are newer than a date that I get from my app. I'm pretty sure I can figure that out if I can get the part I need to work.

Thanks so much.
----------------------------------------------------
Code:
Sub ProcessListFiles(TFolder As String)

    Set fso = New FileSystemObject
    Set fCol = New Collection

    fCol.Add TFolder  'add the top folder path to the collection
      
    sGetFolderCollection TFolder  'call recursive proc to add subfolder paths to collection

   AddFilesToTable (Branches to the subroutine, Correct?)

----------------------------------------------

Sub sGetFolderCollection(TopFold As String)

    Dim oTopFolder As Folder
    Dim fol As Folder
    Dim sfol As Folder

    Set oTopFolder = fso.GetFolder(TopFold)
Debug.Print oTopFolder
    For Each fol In oTopFolder.SubFolders

        fCol.Add fol.Path

        For Each sfol In fol.SubFolders
            Call sGetFolderCollection(sfol.Path)
        Next

    Next fol

End Sub
-----------------------------------------

Sub AddFilesToTable()

    Dim i As Integer
    Dim Fldr As Folder, fl As File
    For i = 1 To fCol.Count                         'loop through the collection of folder paths

        Set Fldr = fso.GetFolder(fCol(i))
Debug.Print Fldr
        For Each fl In Fldr.Files       'loop through folder adding file info to table

            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With
        Next
    Next i
 
Last edited:
Here is the start of my attempt to cannibalize your code. The following is in the OnClick event of a button, but I get this error:

1672352941953.png


On the
Code:
Dim Fldr As Folder, fl As File

Code:
Private Sub GetCallsbtn_Click()
'Mokes Code Get File names and properties and put in Table1
   'Dim i As Integer
    Dim Fldr As Folder, fl As File
    'Dim f1 As File
    'For i = 1 To fCol.Count                         'loop through the collection of folder paths

         Fldr = "c:\Users\me\OneDrive\Documents\Sound recordings"                                       'fso.GetFolder(fCol(i))
Debug.Print Fldr
        For Each fl In Fldr.Files       'loop through folder adding file info to table

            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With
Debug.Print i
        Next
Debug.Print i
    'Next i

End Sub

I have searched all of the code in the example and can't find where you define Folder, if that is what's causing this error. After reading through this so many time, it's becoming clearer. What is also clear is how little I know about this part of VBA. Any edits would be greatly appreciated.

Thanks again
 
Last edited:
It appears to me that the example you sent is like a utility that can be used on a lot of folders containing PDF, pictures and audio files.
The first sections deal with setting up the filepicker and getting the folder to be examined.
Pretty much. I tend to write code in pieces especially when posting examples to simplify them. In this case it was easier to just get a collection of all the folders and subfolders and then use them to get all the files in them. It could be written in one procedure but why complicate it.

I take it your new to using FSO? Here's a few links which I find helpful
https://analystcave.com/vba-filesystemobject-fso-in-excel/
https://www.virtualsplat.com/tips/visual-basic-fso.asp
https://learn.microsoft.com/en-us/o...e/user-interface-help/filesystemobject-object

For my proposes I need to get the file name and properties from a specific folder, every time, and that folder contains audio files in .m4a format.
If it's just one folder with no subfolders its pretty easy.
Code:
Sub AddFilesToTable()

    Dim Fldr As Folder, fl As File
    
        Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")

        For Each fl In Fldr.Files       'loop through folder adding file info to table

' You could add criteria here such as
' If fso.GetExtensionName(fl.Path) = "m4a" then . . . 
'or  If fl.DateCreated > Some Date ...
' or if using a dictionary to limit it to new files
' If not dict.exists(fl.Path) then ...

            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With

        Next

        set fso = nothing
  
End Sub

Lastly, for now, I would like to constrain the output to only files that are newer than a date that I get from my app. I'm pretty sure I can figure that out if I can get the part I need to work.
Is this so you only get files that have not been added to the table yet?
What I do is create a dictionary object and add all the file paths in the table. Scripting.Dictionaries have an exists method which makes it simple to filter out files that have already been added.

Here's an example with the dictionary
 

Attachments

I have searched all of the code in the example and can't find where you define Folder, if that is what's causing this error.
Fldr = "c:\Users\me\OneDrive\Documents\Sound recordings" 'fso.GetFolder(fCol(i))
this line should be - Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")
 
Pretty much. I tend to write code in pieces especially when posting examples to simplify them. In this case it was easier to just get a collection of all the folders and subfolders and then use them to get all the files in them. It could be written in one procedure but why complicate it.

I take it your new to using FSO? Here's a few links which I find helpful
https://analystcave.com/vba-filesystemobject-fso-in-excel/
https://www.virtualsplat.com/tips/visual-basic-fso.asp
https://learn.microsoft.com/en-us/o...e/user-interface-help/filesystemobject-object


If it's just one folder with no subfolders its pretty easy.
Code:
Sub AddFilesToTable()

    Dim Fldr As Folder, fl As File
   
        Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")

        For Each fl In Fldr.Files       'loop through folder adding file info to table

' You could add criteria here such as
' If fso.GetExtensionName(fl.Path) = "m4a" then . . .
'or  If fl.DateCreated > Some Date ...
' or if using a dictionary to limit it to new files
' If not dict.exists(fl.Path) then ...

            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With

        Next

        set fso = nothing
 
End Sub


Is this so you only get files that have not been added to the table yet?
What I do is create a dictionary object and add all the file paths in the table. Scripting.Dictionaries have an exists method which makes it simple to filter out files that have already been added.

Here's an example with the dictionary
A world of thanks, Moke. You are correct, I am new to fso, but not for long. Thanks for sending the links.
The app has one Master file, that keeps track of several bits of data. I can extract the date of the latest entry, then in your code, only bring back data that is newer than the last date in the Master, and append that to the mast, which will reduce the amount of data entered by hand.
This is a huge help, and I can't thank you enough
 
I just copied and pasted the code, and got this error:

1672418598709.png


ON this line
Code:
 Dim Fldr As Folder, fl As File
"Dim Fldr as Folder" was highlighted.

In Googleling the error I get:

"This error has the following causes and solutions: You tried to declare a variable or argument with an undefined data type or you specified an unknown class or object. Use the Type statement in a module to define a new data type."

I changed the the following"

Code:
Private Sub GetCallsbtn_Click()
'Sub AddFilesToTable()

    Dim Fldr As Folder, fl As File
    
        Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")

Does this need to be in a module?

I am using 64 bit office 365, on a 64 bit machine with the latest windows 10

Do not have a clue.
 
Last edited:
Yes, the code should be in a standard module.
I use 32 bit access but I doubt it is a bitness issue.

make sure you have a reference set to Microsoft Scripting runtime and Microsoft Office xx Object Library

msReferences.png


Make sure you include the FSO and Dictionary variables declared at the top of the standard module.
You need to do this so when you instantiate the objects (ie. set fso = new FileScriptingObject, etc) the objects are available to all the procedures in that module. see this link SCOPE
I'm guessing the error your getting is because you dont have this.

msVar.png


in your form you would call it with
Code:
ProcessListFiles strFldr
where strFldr is a variable holding the path to your folder.
 
Last edited:
Yes, the code should be in a standard module.
I use 32 bit access but I doubt it is a bitness issue.

make sure you have a reference set to Microsoft Scripting runtime and Microsoft Office xx Object Library

View attachment 105475

Make sure you include the FSO and Dictionary variables declared at the top of the standard module.
You need to do this so when you instantiate the objects (ie. set fso = new FileScriptingObject, etc) the objects are available to all the procedures in that module. I'm guessing the error your getting is because you dont have this.

View attachment 105476

in your form you would call it with
Code:
ProcessListFiles strFldr
where strFldr is a variable holding the path to your folder.
 
I set the references, both were off, and have the Option Compare database and the dims in the right place. (I put it at the top the the code where there was an option Explicit


Here is what I have now:

Code:
Sub AddFilesToTable()
Dim Fldr As Folder, fl As File
 
        Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")

        For Each fl In Fldr.Files       'loop through folder adding file info to table

' You could add criteria here such as
' If fso.GetExtensionName(fl.Path) = "m4a" then . . .
'or  If fl.DateCreated > Some Date ...
' or if using a dictionary to limit it to new files
' If not dict.exists(fl.Path) then ...

            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With

        Next

        Set fso = Nothing

End Sub

I have it as a sub. You say to call it with "ProcessListFiles strFldr" where strFldr has the path to the folder. When does the path get put into strFldr"?

Sorry for all the questions, but I am learning.
Appreciate your patience.
 

Attachments

  • 1672428644607.png
    1672428644607.png
    5.9 KB · Views: 88
Last edited:
but not clear as to where the Option Explicit goes.
You should have option explicit declared in every module. Option explicit goes at the top right under Option Compare Database. It will catch a lot of your errors. Go to your VB Editor Tools > Options and check off "Require Variable Declaration" It will add Option Explicit to all new modules automatically. You'll have to manually add it to existing modules.

msOptions.png


I stripped the example down to the bare basics and hard coded the file path you posted.
You'll get a message box if the folder doesn't exist.

Click the Run Code button on the form in the attached file

This is all the code in the form module
Code:
Option Compare Database
Option Explicit


Private Sub btoRunCode_Click()

    Dim strFldr As String   'string variable

     strFldr = "c:\Users\me\OneDrive\Documents\Sound recordings"  'path to the folder
       
    If Len(Dir(strFldr, vbDirectory)) = 0 Then MsgBox "Folder doesn't exist": Exit Sub  'test to make sure directory exists
       
    AddFilesToTable strFldr   ' call to start the procedure
   
    Me.lstFiles.Requery

End Sub

Private Sub btoDelete_Click()

    CurrentDb.Execute ("delete * from Table1"), dbFailOnError

    Me.lstFiles.Requery

End Sub

This is all the code in the standard module.

Code:
Option Compare Database
Option Explicit

Dim fso As FileSystemObject   'module level variable

Sub AddFilesToTable(MyFolderPath As String)

    Dim i As Integer
    Dim Fldr As Folder, fl As File
   
    Set fso = New FileSystemObject  'instantiate the filesystemobject
   
    Set Fldr = fso.GetFolder(MyFolderPath)


    For Each fl In Fldr.Files       'loop through folder adding file info to table
     
            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"


            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With

    Next
 
End Sub
 

Attachments

Happy New Year.

Have put the code for the button in the onClick event. However I keep getting a compile error in the module as follows in the following line.
Dim fso as FileSystemObject

1672672282962.png


1672672380547.png


It's crashing in the module, so maybe I hosed it when I created it.
I clicked on the upper left of the form (selected the form)
Then in the code window for the form I selected create module and inserted the code you sent. Let me know if that was correct. It matches the videos and reading I did, but, since this is the first time for this, I may have done it wrong.

Let me know if you need more information.

Have a great year.
 

Attachments

  • 1672672221214.png
    1672672221214.png
    57.3 KB · Views: 85
  • 1672672319134.png
    1672672319134.png
    53 KB · Views: 83
Does my example run on your computer?

Did you set a refernce to microsoft scriptingruntime? see post#28
 
Your example runs fine on my computer. The only thing I had to change was the path, to put my actual 4 char name in the path after Users.

I then deleted all concerning code from my app, and deleted the module (Module1). I then copied what was behind the Run Code button on your example an put it behind the button on my form.

Then, I exported the module from your example into my app. and when I run it I get this error.

1672761684840.png


Error occurs in this line:
Code:
 Me.lstFiles.Requery

Here is the code behind the button: The Option Compare Database and Option Explicit are at the top of this group of code on the form

Private Sub btoRunCode_Click()

Dim strFldr As String 'string variable

strFldr = "c:\Users\jplor\OneDrive\Documents\Sound recordings" 'path to the folder

If Len(Dir(strFldr, vbDirectory)) = 0 Then MsgBox "Folder doesn't exist": Exit Sub 'test to make sure directory exists

AddFilesToTable strFldr ' call to start the procedure

Me.lstFiles.Requery

End Sub


I looked at this a lot last evening, late, and can't see why the code does not run in my app. Last night I found that the reference to scriptingruntime was not set, but I did set it Previously, and probably did not hit OK. Made sure it was set last nught.

1672762310520.png


Here is the code in the module modListNewFiles

Code:
Option Compare Database
Option Explicit


Dim fso As FileSystemObject   'module level variable

Sub AddFilesToTable(MyFolderPath As String)

    Dim i As Integer
    Dim Fldr As Folder, fl As File
    
    Set fso = New FileSystemObject  'instantiate the filesystemobject
    
    Set Fldr = fso.GetFolder(MyFolderPath)

    For Each fl In Fldr.Files       'loop through folder adding file info to table
      
            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With

    Next
  
End Sub


Sorry to be a nuisance.

Thanks
 
I notice that at the top of the module in your example, you don't have the 2nd Dim in the following.

1672766200871.png
 
I must be doing something wrong. I have the code you created in my Form and in a module. but when I click my button I keep getting this:
1672775218139.png

On this line:
Me.lstFiles.Requery

Since lstFiles is not referenced anywhere else in either set of code (that I can find), I am assuming that it's a Dim I don't have, or something like that. But I have checked and everything seems the same. Or, I am creating the module wrong. This has become a very pale looking whale, for me
 
It's got to be something simple, that I can't see. I ust created a new DB with a form and added the same controls that are in your example. I set all the references to the list that you sent, and copied the code into the button and into the module. And, I get the same error - Method or data member not found on the "5Me.lstfiles.Requery" statement.
 
I got it to work. I occurred to me tha the Me.lstFile.Requery loads the text box. Since I don't need that part I left it off, and commented out the requery and Boink, Voila, it works. And it works in my app. The whale turned back to blue.
Learned several things.

Thanks so much for the help
 
Code:
Me.lstfiles.Requery
That code was for the demo, just to requery the listbox on my form which was showing all the files written to the table.


You should also note that you'll probably need to change the below to match your table set up. I did the insert into Table1. You should change it to match your table name. You will probably also have to change the field names "FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " to match the field names in your table.


Code:
Const QDef_Insert As String = _
                "Insert into Table1" & _
             
            Const QDef_Insert As String = _
                "Insert into Table1" & _
                "(FName,FPath,dteCreated,dteModified,FSize,fBaseName,FExt,PFolder) " & _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With


& _
                "Values(p0,p1,p2,p3,p4,p5,p6,p7)"

            With CurrentDb.CreateQueryDef("", QDef_Insert)
                .Parameters(0) = fl.Name
                .Parameters(1) = fl.Path
                .Parameters(2) = fl.DateCreated
                .Parameters(3) = fl.DateLastModified
                .Parameters(4) = fl.Size / 1000000 & "Mb"
                .Parameters(5) = fso.GetBaseName(fl.Path)
                .Parameters(6) = fso.GetExtensionName(fl.Path)
                .Parameters(7) = fso.GetParentFolderName(fl.Path)
                .Execute dbFailOnError
                .Close
            End With


I notice that at the top of the module in your example, you don't have the 2nd Dim in the following.

View attachment 105551
One of the examples used a dictionary object to limit the import to the table of those files which were not yet in the table while ignoring the ones that had been. You indicated you could do that yourself by using a date so I simplified the example and removed the dictionary.
 
Glad you got it working. Good luck with your project.
 

Users who are viewing this thread

Back
Top Bottom