How can I import file names into a table? 7

[Hanss]

I would like to have vb search a directory and import all the file names into an access table. Does anyone have any ideas how this can be done?

Hanss
Zurich

 

[RoyVidar]

Here's some code searching a directory of files and folders (it's populating a listbox, but should be amendable to a query to add the filenames to a table) Nailing Your Files: List Files in a Folder. To select folder, you might look into BrowseFolder Dialog, or try search these forum with the keyword PickFolder (here's one thread705-882847).

Roy-Vidar

 

[mordja]

Hanss,

Here is some code to print out a file list from a target dir.



Public Function PrintPath(ByVal dirPath As String) As Integer
'Compacts all databases in given dir

Dim fso As FileSystemObject
Dim fsoFolder As Folder
Dim fsoFile As File

'Make a new File System object.
Set fso = New FileSystemObject

If Len(Dir(dirPath)) Then
' Get the FSO Folder (directory) object.
Set fsoFolder = fso.GetFolder(dirPath)
For Each fsoFile In fsoFolder.Files
MsgBox fsoFile.Name
Next fsoFile
PrintPath = 0
Else
MsgBox "Invalid Path"
PrintPath = -1
End If

Set fsoFolder = Nothing
Set fso = Nothing

End Function



You could create a recordset and add each filename to your recordset. Do this inside the For Each loop.

Something like

Rst.AddNew
Rst!Filename = fsoFile.Name
Rst.Update


Hope this helps.

Mordja

 

[BobStubbs]

To obtain a list of files in a folder, you need the Dir$ function. Example code which displays .mdb file names found on drive S: in the debug window:

Sub DirTest()

Dim strFolderName As String
'----------------------------------------------
'- The first time you call Dir$, you pass it  -
'- the folder name, and file type if required -
'----------------------------------------------
strFolderName = Dir$("s:\*.mdb")

debug.print strFolderName

'----------------------------------------------
'- Now you execute a loop, calling Dir$ again -
'- with no parameters.  This will return file -
'- names until all have been found, then      -
'- returns "" - blank string                  -
'----------------------------------------------

Do
    strFolderName = Dir$
    debug.print strFolderName
Loop Until strFolderName = ""

End Sub

To insert these results in a table, you can use the RunSQL command:

dim strSQL as string

strSQL = "INSERT INTO tblTableName (Filename) "
strSQL = strSQL & "VALUES (" & strFileName & ")"

DoCmd.SetWarnings (False)
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings (True)

Combining these two examples gives:

Sub GetFileNames()

Dim strFolderName As String

strFolderName = Dir$("s:\*.mdb")

SaveFileName(strFolderName)

Do
    strFolderName = Dir$
    SaveFileName(strFolderName)
Loop Until strFolderName = ""

End Sub

Function SaveFileName(strFileName as string)

dim strSQL as string

if strFileName = "" then
    exit function
end if

strSQL = "INSERT INTO tblFileNames (Filename) "
strSQL = strSQL & "VALUES (" & strFileName & ")"

DoCmd.SetWarnings (False)
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings (True)

End Function

I hope that these examples will give you some useful ideas.


Bob Stubbs

 

[Hanss]

Thank you all VERY much for all this stuff. I will try it and get back to you.

hanss

 

[sharonniles]

Hi Everyone,
I'm doing something very similar to Hanss. Thank you Bob, for the great example. When running the example, I get stuck at
DoCmd.RunSQL (strSQL)
The error says:
Runtime error 3075
Syntax error (missing operator) in query expression
My table in Access is tblDirectory with two fields
FileName
FileDate
(I did change your tblFileNames to tblDirectory).

In my application, I'm checking the file contents of an entire subdirectory. Any help is much appreciated.

Sincerely,
Sharon Niles

 

[Aqif]

Hi,

Try this function as well. It allows to search SubFolders as well. You can turn off subfolder serach in function argument.

--------------------------------------------------------
Public Function AppendFileList(strFolder As String, IncludeSubFolders As Boolean)
On Error GoTo errHandler

Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As File
Dim strFileNames As String
Dim strSubFolder As Folder

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)


'CREATE TABLE OF FILES
'---------------------

'Drop table TblFiles first
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from TblFileList"
DoCmd.DeleteObject acTable, "TblFileList"

'Create Table TblFileList
DoCmd.RunSQL "Create Table TblFileList (Filename Text(255), Folder Text(255), [FileSize (KB)] Number);"


'To scan root files
'------------------

For Each objFiles In objFolder.Files

' SysCmd acSysCmdSetStatus, objFolder.Path

DoCmd.SetWarnings False
strCount = strCount + 1
DoCmd.RunSQL ("Insert Into TblFileList Values('" & objFiles.Name & "','" & objFolder.Path & "'," & Round(objFiles.Size / 1024, 2) & ");")
DoCmd.SetWarnings True
DoEvents
strFilesFound = strFilesFound & vbCrLf & objFiles.Name

Next


'To scan sub folders
'-------------------
If IncludeSubFolders = True Then

For Each strSubFolder In objFolder.SubFolders
Call AppendFileList(strSubFolder.Path, True)
Next

End If

errHandler:
If Err.Number > 0 Then

If MsgBox("Encountered following error. " & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & "Do you want to exit?", vbYesNo + vbExclamation, "Error") = vbYes Then
End
Else
Resume Next
End If

End If

End Function
--------------------------------------------------------

Cheers!
ÙÇãá

It's important to learn the rules so that you know how to break them.

 

[sharonniles]

Hi Agif,
Thanks for the post. I believe my project should use FSO. You've pointed me in the right direction. I'm going to try it out.
Thanks again.
Sharon Niles

 

[BobStubbs]

Sharon ... two further suggestions which may help.

1. If you get this type of error message, comment out the RunSQL line, and substitute a Msgbox or debug.print line. Example:

DoCmd.SetWarnings (False)
'DoCmd.RunSQL (strSQL)
msgbox strSQL
debug.print strSQL
DoCmd.SetWarnings (True)

This will then display the SQL string which Access has built, in a message box or the Immediate pane in the VBA window.

When I checked my example code, I realised I had missed out the single quote characters needed when you are inserting a string (oops!) The correct syntax is:

strSQL = "INSERT INTO tblFileNames (Filename) "
strSQL = strSQL & "VALUES ('" & strFileName & "')"

2. You can get the date and time stamp from a file, using the FileDateTime function. Example:

msgbox FileDateTime("S:\" & strFileName)

So, to extract the file date as well as the name, and store both in your table, you need a function like this:

Function SaveFileDetails(strFilePath as string, strFileName as string)
'Pass the path to the file, as well as the
'file name, to this function

dim strFileDate as string
dim strSQL as string

if strFileName = "" then
    exit function
end if

'Get the file date and time
strFileDate = FileDateTime(strFilePath & strFileName)

'Format the date as required for your table
strFileDate = Format$(strFileDate, "dd/mm/yyyy")

strSQL = "INSERT INTO tblFileNames (Filename, Filedate) "
strSQL = strSQL & " VALUES ('" & strFileName & "', '"
strSQL = strSQL & strFileDate & "')"

DoCmd.SetWarnings (False)
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings (True)

End Function

I hope this helps.


Bob Stubbs

 

[Hanss]

Agif,

I am NOT a programmer. I simply cut and pasted your code into a module, made the table and put this in the immediate window:

? appendfilelist ("c:\test","false" )

And ... IT WORKED PERFECTLY!!!

Just 2 questions:

1) How can I get the file date too?
2) Is it possible to just get the file name without the extention or is it better that I use a query in access?

I am also going to experiment with Bob's code as well and get back.

- Hanss

 

[Hanss]

Bob,

I got your code going as well. I ended up using the FileDateTime function you referred to to get this into Agif's code which I ended up using.

Thank you all for your help!!!

Hanss

 

[sharonniles]

Thanks Bob, I got it to work with the SQL correction. Amazing what a set of apostrophe's accomplish!!

Agif,
I get a compile error. Sub or Function not defined. Any ideas?

 

[shoyle]

Use the FileSystemObject Class. You will want to create a folder variable as well and then loop through the files within your chosen folder. Have it copy the names of the file into a table - you can use the Left() or Right() to obtain your specific file name.
Here's part of an app I created. It may help with the concept.

Option Explicit
Const source As String = "C:\Workbench" ' source folder
Const dest As String = "O:\Backups\" 'destination folder

Private Sub cmdStart_Click()
Dim fs As FileSystemObject
Dim dte As String 'converts souce file date to year,month,day format
Dim destname As String
Dim FileDate As Variant 'date of import file last modified
Dim fil As File
Dim fld As Folder
Dim fld2 As Folder
Dim source2 As String

Set fs = New FileSystemObject
Set fld = fs.GetFolder(source)



Screen.MousePointer = vbHourglass
'fs.DeleteFile dest & "*"
'fs.DeleteFolder dest & "*"


For Each fld2 In fld.SubFolders


'For Each fil In fld2.Files

' source2 = fil.Path
'destname = fil.Name
'fs.CopyFile source2, dest & destname 'copying source file to dest

'txtStatus.Text = "Now backing up...." & destname
'Form1.Refresh
'Next fil

source2 = fld2.Path
destname = fld2.Name
fs.CopyFolder source2, dest & destname
txtStatus.Text = "Now backing up Folder...." & destname
Form1.Refresh

Next fld2

Screen.MousePointer = vbDefault
txtStatus.Text = "Backup Completed."
End Sub

 

[Aqif]

Dear Hanss

You can use these properties with objFiles object that has been created through FileSystem

objFiles.DateCreated
objFiles.DateLastAccessed
objFiles.DateLastModified

Dear Bob

Try pasting the whole code a in seperate module. You have to save Function with the same name ie. AppendFileList as the function calls itself again ie. Call AppendFileList(strSubFolder.Path, True).

Hope I make sense



Cheers!
ÙÇãá

It's important to learn the rules so that you know how to break them.

 

[sharonniles]

Hi Agif (and everybody),
I finally got your routine to work!! I wanted this to work through an Access form. I kept getting only the last subdirectory in the tblFileList table. So I moved the section setting up the table in the first section of the subroutine. This is what I did:

Option Compare Database
Private Sub cmdStart_Click()
'CREATE TABLE OF FILES
'---------------------

'Drop table TblFiles first
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from TblFileList"
DoCmd.DeleteObject acTable, "TblFileList"

'Create Table TblFileList
DoCmd.RunSQL "Create Table TblFileList (Filename Text(255), Folder Text(255), [FileSize (KB)] Number);"

Call AppendFileList("c:\email attachments1", True)

End Sub

Public Function AppendFileList(strFolder As String, IncludeSubFolders As Boolean)
On Error GoTo errHandler

Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As File
Dim strFileNames As String
Dim strSubFolder As Folder

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)




'To scan root files
'------------------

For Each objFiles In objFolder.Files

' SysCmd acSysCmdSetStatus, objFolder.Path

DoCmd.SetWarnings False
strCount = strCount + 1
DoCmd.RunSQL ("Insert Into TblFileList Values('" & objFiles.Name & "','" & objFolder.path & "'," & Round(objFiles.Size / 1024, 2) & ");")
DoCmd.SetWarnings True
DoEvents
strFilesFound = strFilesFound & vbCrLf & objFiles.Name

Next


'To scan sub folders
'-------------------
If IncludeSubFolders = True Then

For Each strSubFolder In objFolder.SubFolders
Call AppendFileList(strSubFolder.path, True)

Next

End If

errHandler:
If Err.Number > 0 Then

If MsgBox("Encountered following error. " & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & "Do you want to exit?", vbYesNo + vbExclamation, "Error") = vbYes Then
End
Else
Resume Next
End If

End If

End Function

Agif, thanks again for your help. (I did get Bob Stubb's routine to work also, but not the subdirectories.)

Sincerely,
Sharon Niles

 

[tubbers]

I'm also trying to create a table with a list of filenames and their path. The files can be in a variety of folders and subfolders and I need the output to be in a table like this:

FileName FilePath
RR1320600.mdb c:\3D\Final\Tat\132\RR1320600.mdb
RR1320800.mdb c:\3D\Final\Tat\132\RR1320800.mdb
RR1341000.mdb c:\3D\Final\Tat\134\RR1320600.mdb
etc...

I'm using the following code:

Option Explicit

Public Function AppendFileList(strFolder As String, IncludeSubFolders As Boolean)
On Error GoTo errHandler

Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As File
Dim strFileNames As String
Dim strSubFolder As Folder
Dim strCount As String
Dim strFilesFound As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)

For Each objFiles In objFolder.Files
DoCmd.SetWarnings False
strCount = strCount + 1
DoCmd.RunSQL ("Insert Into BatchImport Values('" & objFiles.Name & "','" & objFolder.Path & "';")
DoCmd.SetWarnings True
DoEvents
strFilesFound = strFilesFound & vbCrLf & objFiles.Name

Next

If IncludeSubFolders = True Then
For Each strSubFolder In objFolder.SubFolders
Call AppendFileList(strSubFolder.Path, True)
Next
End If

errHandler:
If Err.Number > 0 Then
If MsgBox("Encountered following error." & vbCrLf & vbCrLf & Err.Number & "-" & Err.Description & vbCrLf & vbCrLf & "Do you want to exit?", vbYesNo + vbExclamation, "Error") = vbYes Then
End
Else
Resume Next
End If
End If
End Function

My table is called BatchImport and has the following structure:

FileName (text)
FilePath (text)
SourceName (default value = "PosEchoes")
SourceType (default value = "Microsoft Access")

I use this table to run an command to automatically link the PosEchoes table from each mdb to a master mdb.

My problem is when I run ?appendfilelist ("c:\sockeye3d\finalruns\tat", "False") from the immediate window, the cursor jumps down a few lines but I do not get any results (or error messages).

I don't really understand VBA at this point so would be eternally grateful if someone could help point out where I've gone wrong.

 

[PHV]

Replace this:
Dim strCount As String
By this:
Replace this:
Dim strCount As Long
DoCmd.RunSQL ("Insert Into BatchImport Values('" & objFiles.Name & "','" & objFolder.Path & "';")
By this:
DoCmd.RunSQL "Insert Into BatchImport(FileName,FilePath) Values('" & objFiles.Name & "','" & objFolder.Path & "');"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[PHV]

Oops, hit submit to quickly ...
Replace this:
Dim strCount As String
By this:
Dim strCount As Long

Replace this:
DoCmd.RunSQL ("Insert Into BatchImport Values('" & objFiles.Name & "','" & objFolder.Path & "';")
By this:
DoCmd.RunSQL "Insert Into BatchImport(FileName,FilePath) Values('" & objFiles.Name & "','" & objFolder.Path & "');"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[tubbers]

Thanks, PHV.

I made the changes you suggested and still have the same problem...once I try to run it in the immediate window, the cursor drops a few lines and thats it. No data or error message.

 

[PHV]

Try to comment oput the On Error instruction.
You may also step thru the code:
Hit F9 while the cursor is on the Set fso line, launch the code in the immediate window and play with the F8 key and uor mouse pointer.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244