M
MM
I have a routine that runs through a folder of image files (25,000
images) and updates a table (45,000 records) with the image file name
when it finds a match. It works fine but takes over 24 hours, any
suggestions on how to speed it up would be appreciated.
MM
Option Compare Database
Private Sub Command0_Click()
''
'' GET FILE NAMES FROM GRAPHICS FOLDER
''
Dim sFileDir As String
Dim rsFileInfo As ADODB.Recordset
Set rsFileInfo = New ADODB.Recordset
' create the filename field -- this is a string data type, length
255
rsFileInfo.Fields.Append "FileName", adBSTR, 255
' open the recordset
rsFileInfo.Open
' get the files in the correct directory
sFileDir = Dir("i:\thumbs\*.jpg") ' change the path as
necessary
Do While sFileDir <> ""
If sFileDir <> "." And sFileDir <> ".." Then
rsFileInfo.AddNew
' rsFileInfo!FileName = sFileDir
' alternatively, use the next line instead to get the
file name
' minus the last four characters ".jpg"
rsFileInfo!FileName = Left(sFileDir, Len(sFileDir) -
4)
rsFileInfo.Update
Debug.Print rsFileInfo!FileName
' get the next file in the directory
sFileDir = Dir
End If
Loop
rsFileInfo.MoveFirst
''
'' COMPARE FILES TO RECORDS IN INVENTORY TABLE USING ITEMMAP
''
Dim rsInv As ADODB.Recordset
Set rsInv = New ADODB.Recordset
rsInv.ActiveConnection = CurrentProject.Connection
rsInv.Open "SELECT ItemMap.InItem, Inventory.ProdCode,
ItemMap.InItem AS ChkCode, Inventory.PathToImagesFolder FROM ItemMap
INNER JOIN Inventory ON ItemMap.OutItem = Inventory.ProdCode;", ,
adOpenKeyset, adLockOptimistic
' loop thru recordset to find matches in rsFileInfo
Do Until rsInv.EOF
Do Until rsFileInfo.EOF
If rsInv!ChkCode = rsFileInfo!FileName Then
rsInv!PathToImagesFolder = rsFileInfo!FileName &
".jpg"
End If
rsFileInfo.MoveNext
Loop
rsFileInfo.MoveFirst
rsInv.MoveNext
Loop
rsFileInfo.Close
rsInv.Close
Set rsFileInfo = Nothing
Set rsInv = Nothing
End
End Sub
images) and updates a table (45,000 records) with the image file name
when it finds a match. It works fine but takes over 24 hours, any
suggestions on how to speed it up would be appreciated.
MM
Option Compare Database
Private Sub Command0_Click()
''
'' GET FILE NAMES FROM GRAPHICS FOLDER
''
Dim sFileDir As String
Dim rsFileInfo As ADODB.Recordset
Set rsFileInfo = New ADODB.Recordset
' create the filename field -- this is a string data type, length
255
rsFileInfo.Fields.Append "FileName", adBSTR, 255
' open the recordset
rsFileInfo.Open
' get the files in the correct directory
sFileDir = Dir("i:\thumbs\*.jpg") ' change the path as
necessary
Do While sFileDir <> ""
If sFileDir <> "." And sFileDir <> ".." Then
rsFileInfo.AddNew
' rsFileInfo!FileName = sFileDir
' alternatively, use the next line instead to get the
file name
' minus the last four characters ".jpg"
rsFileInfo!FileName = Left(sFileDir, Len(sFileDir) -
4)
rsFileInfo.Update
Debug.Print rsFileInfo!FileName
' get the next file in the directory
sFileDir = Dir
End If
Loop
rsFileInfo.MoveFirst
''
'' COMPARE FILES TO RECORDS IN INVENTORY TABLE USING ITEMMAP
''
Dim rsInv As ADODB.Recordset
Set rsInv = New ADODB.Recordset
rsInv.ActiveConnection = CurrentProject.Connection
rsInv.Open "SELECT ItemMap.InItem, Inventory.ProdCode,
ItemMap.InItem AS ChkCode, Inventory.PathToImagesFolder FROM ItemMap
INNER JOIN Inventory ON ItemMap.OutItem = Inventory.ProdCode;", ,
adOpenKeyset, adLockOptimistic
' loop thru recordset to find matches in rsFileInfo
Do Until rsInv.EOF
Do Until rsFileInfo.EOF
If rsInv!ChkCode = rsFileInfo!FileName Then
rsInv!PathToImagesFolder = rsFileInfo!FileName &
".jpg"
End If
rsFileInfo.MoveNext
Loop
rsFileInfo.MoveFirst
rsInv.MoveNext
Loop
rsFileInfo.Close
rsInv.Close
Set rsFileInfo = Nothing
Set rsInv = Nothing
End
End Sub