I found this very helpful bit of code to 'import' the filename and filepath of files into an access table:
Source: https://www.everythingaccess.com/tutorials.asp?ID=List-files-to-a-table
The only thing I wanted to change in it, was a way to prevent duplicate records being created. What I did was add the code to a function and then call it using a button.
The button does import the directory list into the table, but every time I click the button it will import the list entirely again. I only want to be able to import new items to the table.
So say for example there are 100 images in a folder. When I click the button, it should import those 100 images' filename and filepath into the table I specified. Which the code does successfully. But what I don't want (which is happening at the moment) is each time I click the button, duplicate records of those 100 images metadata are created. I only want the code to add new records. So if another 15 images get updated tomorrow, I should be able to append those to the table but not the records pre-existing in the table already.
Thanks and wishing everyone a belated happy new year.
Code:
Option Compare Database
Option Explicit
'list files to tables
'http://allenbrowne.com/ser-59alt.html
Dim gCount As Long ' added by Crystal
Sub runListFiles()
'Usage example.
Dim strPath As String _
, strFileSpec As String _
, booIncludeSubfolders As Boolean
strPath = "E:\"
strFileSpec = "*.*"
booIncludeSubfolders = True
ListFilesToTable strPath, strFileSpec, booIncludeSubfolders
End Sub
'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable(strPath As String _
, Optional strFileSpec As String = "*.*" _
, Optional bIncludeSubfolders As Boolean _
)
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.
'Method: FilDir() adds items to a collection, calling itself recursively for subfolders.
Dim colDirList As New Collection
Dim varitem As Variant
Dim rst As DAO.Recordset
Dim mStartTime As Date _
, mSeconds As Long _
, mMin As Long _
, mMsg As String
mStartTime = Now()
'--------
Call FillDirToTable(colDirList, strPath, strFileSpec, bIncludeSubfolders)
mSeconds = DateDiff("s", mStartTime, Now())
mMin = mSeconds \ 60
If mMin > 0 Then
mMsg = mMin & " min "
mSeconds = mSeconds - (mMin * 60)
Else
mMsg = ""
End If
mMsg = mMsg & mSeconds & " seconds"
MsgBox "Done adding " & format(gCount, "#,##0") & " files from " & strPath _
& IIf(Len(Trim(strFileSpec)) > 0, " for file specification --> " & strFileSpec, "") _
& vbCrLf & vbCrLf & mMsg, , "Done"
Exit_Handler:
SysCmd acSysCmdClearStatus
'--------
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, , "ERROR"
'remove next line after debugged -- added by Crystal
Stop: Resume 'added by Crystal
Resume Exit_Handler
End Function
Private Function FillDirToTable(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
On Error GoTo Err_Handler
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim strSQL As String
'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
gCount = gCount + 1
SysCmd acSysCmdSetStatus, gCount
strSQL = "INSERT INTO Files " _
& " (FName, FPath) " _
& " SELECT """ & strTemp & """" _
& ", """ & strFolder & """;"
CurrentDb.Execute strSQL
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 FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
Exit_Handler:
Exit Function
Err_Handler:
strSQL = "INSERT INTO Files " _
& " (FName, FPath) " _
& " SELECT "" ~~~ ERROR ~~~""" _
& ", """ & strFolder & """;"
CurrentDb.Execute strSQL
Resume Exit_Handler
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 FunctionSource: https://www.everythingaccess.com/tutorials.asp?ID=List-files-to-a-table
The only thing I wanted to change in it, was a way to prevent duplicate records being created. What I did was add the code to a function and then call it using a button.
The button does import the directory list into the table, but every time I click the button it will import the list entirely again. I only want to be able to import new items to the table.
So say for example there are 100 images in a folder. When I click the button, it should import those 100 images' filename and filepath into the table I specified. Which the code does successfully. But what I don't want (which is happening at the moment) is each time I click the button, duplicate records of those 100 images metadata are created. I only want the code to add new records. So if another 15 images get updated tomorrow, I should be able to append those to the table but not the records pre-existing in the table already.
Thanks and wishing everyone a belated happy new year.
