[AccessD] Questions about Attachments

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
'-----------------------------------------------------





More information about the AccessD mailing list