Solved: Compile a table from files in a folder

[Adonaioc]

I want to have a database that compiles a table from all the files in a folder, from the second "." left needs to be the record and a link to that file in the 2nd field. Is that even possible? I thought i could figure it out from the code you gave me to update the links but i cant figure out how to do it from a blank table

[CreganTur]

I don't remember that code off hand- but I think I remember that the file names are collected in either a recordset or an array.

Once you've created your blank table you can use a SQL Update query to add the file's name and filepath to the table. You'll need to itterate through all of the files- if it's an array you'll itterate from the LBound to the UBound. If it's a recordset then you'll loop through it until you reach EOF.

[Adonaioc]

I found this code but im not sure how to make it put the data into a table

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
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.
' lst: if you pass in a list box, items are added to it. If not, files are listed to immediate window.
' The list box must have its Row Source Type property set to Value List.
'Method: FilDir() adds items to a collection, calling itself recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(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
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
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 FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
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

[OBP]

That looks extremely complicated compared to

Private Sub cmdGetSource_Click()
On Error GoTo errorcatch
Dim count As Integer, rs As Object, foundfile As String, counter As Integer, Filelength As Double, docname As String, fs, filedate As Date
Dim filetype As String
If Me.Selected_Document_Type = "" Or IsNull(Me.Selected_Document_Type) Then Me.Selected_Document_Type = "*.*"
filetype = Me.Selected_Document_Type
Set rs = CurrentDb.OpenRecordset("Documents")
Set fs = CreateObject("Scripting.FileSystemObject")
Msg = "Select a location containing the files you want get Data on."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
Me.Document_Location = Directory

With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = Me.Selected_Document_Type
If Frame1 = 1 Then .SearchSubFolders = False
If Frame1 = 2 Then .SearchSubFolders = True
If .Execute() > 0 Then
counter = .FoundFiles.count
MsgBox "There were " & counter & " file(s) found."
For count = 1 To .FoundFiles.count
filedate = FileDateTime(.FoundFiles(count))
Filelength = FileLen(.FoundFiles(count))
foundfile = .FoundFiles(count)
docname = fs.GetFileName(foundfile)
With rs
.AddNew
![Document Location] = foundfile
![Document Type] = Right(![Document Location], 4)
![Last Accessed] = filedate
![File Size] = Filelength
![Document Name] = docname
.Update
.Bookmark = .LastModified
End With
Next count
Else
MsgBox "There were no files found."
End If
End With
MsgBox "Finished Copying Data to Table"
rs.Close
Set rs = Nothing
Set fs = Nothing

Exit Sub

errorcatch:
MsgBox Err.Description
Set rs = Nothing
Set fs = Nothing

Although it does use a couple of Function Modules as well.

If you want a copy of my Document Management database which contains that Code to mess around with you are quite welcome to it.

[FrymanTCU]

OBP, Post the database! That sounds like a useful code that might help keep track of all the daily download files I create.

[OBP]

Here it is, it is by no means finished, I am too busy to complete it.

[PokerAce]

I would also like to get this database.

[walker9867]

Posted to get a copy of the database...

[Adonaioc]

Here is the code for excel, I still have not found anything for access yet

Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
' returns the full filename for files matching
' the filter criteria in the current folder
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
'designate folder
.LookIn = "Q:\9500"
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
End Function

Sub TestCreateList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:\My Documents"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

[OBP]

Didn't you bother to read the either of my Posts? :dunno :banghead:

I posted the Access version and also a Database with it being used and a lot more besides. :mkay