M
MM
I have an access db that I use to manage the updates and maintenece
of our SQL based web data. One of the functions is to update the filed
to note when we have a product image.With some help several years ago
from this group I was able to get the following code to work. This
code looks at all th eimage files in a folder against the product code
in inventory table and if a match is found it adds the needed filename
detail to a field.
Over the years the images have build up and I'd like to delete the
image files that exist were there is no matching inventory item any
more.
Suggestions/
Public Function ImageTest()
''
'' GET FILE NAMES FROM 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:\*.jpg") ' change the path as necessary
Do While sFileDir <> ""
If sFileDir <> "." And sFileDir <> ".." Then
rsFileInfo.AddNew
' rsFileInfo!FileName = sFileDir
' 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
''
Dim rsInv As ADODB.Recordset
Set rsInv = New ADODB.Recordset
rsInv.ActiveConnection = CurrentProject.Connection
' open recordset of all inventory records
rsInv.Open "SELECT * FROM Inventory WHERE (((Inventory.ProdCode)is
not null));", , adOpenKeyset, adLockOptimistic
' loop thru recordset to find matches in rsFileInfo
Do Until rsInv.EOF
Do Until rsFileInfo.EOF
' we've taken out the ".jpg" from the filename
If rsInv!ProdCode = 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 Function
Thanks in advance,
MM
of our SQL based web data. One of the functions is to update the filed
to note when we have a product image.With some help several years ago
from this group I was able to get the following code to work. This
code looks at all th eimage files in a folder against the product code
in inventory table and if a match is found it adds the needed filename
detail to a field.
Over the years the images have build up and I'd like to delete the
image files that exist were there is no matching inventory item any
more.
Suggestions/
Public Function ImageTest()
''
'' GET FILE NAMES FROM 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:\*.jpg") ' change the path as necessary
Do While sFileDir <> ""
If sFileDir <> "." And sFileDir <> ".." Then
rsFileInfo.AddNew
' rsFileInfo!FileName = sFileDir
' 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
''
Dim rsInv As ADODB.Recordset
Set rsInv = New ADODB.Recordset
rsInv.ActiveConnection = CurrentProject.Connection
' open recordset of all inventory records
rsInv.Open "SELECT * FROM Inventory WHERE (((Inventory.ProdCode)is
not null));", , adOpenKeyset, adLockOptimistic
' loop thru recordset to find matches in rsFileInfo
Do Until rsInv.EOF
Do Until rsFileInfo.EOF
' we've taken out the ".jpg" from the filename
If rsInv!ProdCode = 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 Function
Thanks in advance,
MM