First thing on Thursday AM.Post what you don't understand and we'll explain.
First thing on Thursday AM.Post what you don't understand and we'll explain.
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
Dim Fldr As Folder, fl As File
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
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.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.
If it's just one folder with no subfolders its pretty easy.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.
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?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.
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.
this line should be - Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")Fldr = "c:\Users\me\OneDrive\Documents\Sound recordings" 'fso.GetFolder(fCol(i))
A world of thanks, Moke. You are correct, I am new to fso, but not for long. Thanks for sending the links.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
Dim Fldr As Folder, fl As File
Private Sub GetCallsbtn_Click()
'Sub AddFilesToTable()
Dim Fldr As Folder, fl As File
Set Fldr = fso.GetFolder("c:\Users\me\OneDrive\Documents\Sound recordings")
ProcessListFiles strFldr
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
where strFldr is a variable holding the path to your folder.Code:ProcessListFiles strFldr
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
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.but not clear as to where the Option Explicit goes.
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
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
Me.lstFiles.Requery
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
Me.lstfiles.Requery
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
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.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