Dan Waters
df.waters at comcast.net
Tue May 28 14:02:58 CDT 2013
Hi Arthur,
Coincidence! Yesterday I wrote the following procedure to store photographs
for a small inventory management system. I made the file name unique by
incorporating the year, month, day, hour, minute, and second. I also
included the unique Stock Number because someone invariably wants to
directly find the file by the stock number name. There can be more than one
photo for each stock number.
CleanFileName is a library procedure used to strip illegal characters from
the Stock Number which can't be used in a file name.
Const IllegalCharacters As String = "#;:?/\+[]{}()<>`|^*~=@$!_~%" & """"
& vbTab
Procedure:
'------------------------------
Private Sub butGetPhoto_Click()
Dim stgFilePathOriginal As String
Dim stgInventoryPhotoPath As String
Dim fso As FileSystemObject
Dim stgPhotoFileName As String
Dim stgFilePathNew As String
Dim stg As String
Dim lngInventoryID As Long
'-- Storing a new file
stgFilePathOriginal = GetFilePath
If stgFilePathOriginal = "" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
stgInventoryPhotoPath = CurrentProject.Path & "\InventoryPhotos\"
If fso.FolderExists(stgInventoryPhotoPath) = False Then
fso.CreateFolder stgInventoryPhotoPath
End If
stgPhotoFileName = "SN" & Me.Parent.txtStockNumber
stgPhotoFileName = CleanFileName(stgPhotoFileName)
stgPhotoFileName = Replace(stgPhotoFileName, " ", "")
stgPhotoFileName = stgPhotoFileName & "_" & Format(Now(), "yyyy") &
Format(Now(), "mm") & Format(Now(), "dd") & "_" & Format(Now(), "HhNnSs")
stgFilePathNew = stgInventoryPhotoPath & stgPhotoFileName & "." &
fso.GetExtensionName(stgFilePathOriginal)
fso.CopyFile stgFilePathOriginal, stgFilePathNew, True
'-- Save file path
lngInventoryID = Me.Parent.txtInventoryID
stg = "INSERT INTO tblPhotographs ( InventoryID, PhotoFilePath )" _
& " VALUES (" & lngInventoryID & ", '" & stgFilePathNew & "')"
DBEngine(0)(0).Execute stg, dbSeeChanges Or dbFailOnError
End Sub
'-----------------------------------------------------