I would like to loop through all the files in a specified directory and add the filenames to a table. The example I'm given doesn't work for me. Here's what I have:
Code:
Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s
folderspec = "C:\Documents and Settings\e3utbl\Desktop\FTPTest\Audit_Docs_Mgmt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
s = s & f1.Name
s = s & vbCrLf
Next
Debug.Print s
End Sub
Can someone help me to determine what I'm doing wrong?
The code you have is designed to print the list of files to the VBA Immediate window. Are you saying it's not doing that?
If you are wanting to know how to use this code to store the files to a table then here's one way:
Code:
Public Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblFiles")
folderspec = "C:\Documents and Settings\e3utbl\Desktop\FTPTest\Audit_Docs_Mgmt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
rs.AddNew
rs.Fields("FileName") = f1.Name
rs.Update
Next
Set rs = Nothing
End Sub
In the above example,the table is called tblFiles and the fieldname is called FileName.
you can use dir. this bit of aircode will be close to what you want
the only problem with dir is that it is not recursive, so you cant examine subfolders at the same time.
Code:
fname = dir("somepath",vbnormal)
while fname<>""
process the file
fname = dir() 'get the next file
wend
It does deal with subfolders, is recursive and offers various outputs
The code is at the site.
'-----------------------------------------------------------------
' Procedure : ListFiles
' DateTime : 2007-09-17 15:24
' Author : drawbrij
' Purpose : This description was obtained from Internet - Allen Browne
' see http://allenbrowne.com/ser-59.html
'
' How it works
'ListFiles() is the main routine.
'It uses a collection to demonstrate how the file names can
'all be collected, and then output in different ways
'(list box, table, immediate window.)
'FillDir() does the work of looping through the files
'in a folder that meet the file specification, and
'adding them to the collection. If we are to include the
'subfolders as well, the second part loops through all
'the files again to identify those that are directories.
'It ignores the "." and ".." entries, uses GetAttr() to
'identify the directories, and adds them to the colFolders
'collection. Then for each of the folders in this collection,
'the function calls itself again to handle the files in
'that folder. If that folder contains subfolders also,
'the function will continue to call itself recursively, to
'whatever depth is required.
'The TrailingSlash() function just ensures that the folder
'names we are processing end with the slash character.
Here is a test routine.
Code:
'---------------------------------------------------------------------------------------
' Procedure : TestAllenBrowneListFiles
' DateTime : 2007-09-19 16:20
' Author : drawbrij
' Purpose : This proc is intended for Testing the
' ListFiles procedure obtained from Allen Browne's website.
'---------------------------------------------------------------------------------------
'
Sub TestAllenBrowneListFiles()
On Error GoTo TestAllenBrowneListFiles_Error
ListFiles "c:\users\jack\", "*.mdb", True
On Error GoTo 0
Exit Sub
TestAllenBrowneListFiles_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure TestAllenBrowneListFiles of Module AllanBrowneDirectoryStuff"
End Sub
Sub ShowFolderList() ' (folderspec)
Dim fs, f, f1, fc, s
'folderspec = "C:\Documents and Settings\e3utbl\Desktop\FTPTest\Audit_Docs_Mgmt"
folderspec = "C:\users\jack\a2k\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.files
For Each f1 In fc
s = s & f1.name
s = s & vbCrLf
Next
Debug.Print s
End Sub
If you're using the FileSystemObject example then you didn't need to set a reference. The code utilises what is called Late Binding which creates an object on-the-fly without the need of a reference.
Can I get your advice if i wanted to use this code to run on a mac operating system how would this be possible due to the Mac not using a drive location?
I used to save pictures related to a job as an attachment in an attachment field. My database grew in size dramatically, so I set up a bound subform on my main Orders form to save each picture as a hyperlink. The form and subform are linked by the field "OrderNumber". The pictures for each order are saved in a directory unique to that order number.
At first, I had to add each picture individually to the subform, but for large orders, that took time. I used the following code to get all of the pictures at once and populate the table/subform. And it works well. However, if you click the button again, it adds them all again, and again - as many times as you click it. This can cause problems with other users. What I am looking for is way to first check if they exist in the table already, and if so, not to add it again. This is the code I am using to add the pictures:
Code:
Private Sub btnGetPictures_Click()
On Error GoTo Err_btnGetPictures_Click
Dim folderspec As String
Dim fs As Object
Dim f As Object
Dim f1 As Object
Dim fc As Object
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblJobPix")
folderspec = "C:\FilePath\Job Pix\" & [Forms]![frmOrders]![CustNumber] & "\" & [Forms]![frmOrders]![OrderNumber] & " " & [Forms]![frmOrders]![ClientUserlastName]
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
rs.AddNew
rs.Fields("OrderNumber") = [Forms]![frmOrders]![OrderNumber]
rs.Fields("ImageFilePath") = (folderspec & "\" & f1.Name)
rs.Update
Next
Me.Requery
Set rs = Nothing
Exit_btnGetPictures_Click:
Exit Sub
Err_btnGetPictures_Click:
MsgBox Err.Description, vbInformation, "Attention"
Resume Exit_btnGetPictures_Click
End Sub
Should I be using an If Len statement first to check the existence of the file name first? And I am not sure how to write it. Any help here would be appreciated.