Code Streamlimg Issue

[vShaneCurtis]

Hello All,

I am hoping you may be able to help me with a code streamling issue. I am creating a card database. My main table has three OLE Object fields that will be used to store the card images as BLOBs. There are three images of each card. A large image a medium sized image and a thumbnail image. Each set of card images is stored in its own directory. Each directory contains the same number of files. The file names for each card image are the same. The code to write the card data for each card is currently contained in separate procedures. Each procedure is almost identical with the exception of the path to the file and the field name that the data is written to.

I'm struggling in coming up with a way to consolidate these three procedures into a single procedure that opens each of the three different card images for each card reads the data and writes it to the correct field then repeats the process until all the files have been processed.

Here is the code for one of the procedures:

Public Sub AddLargeImage(ByVal Path As String)
Dim FullPath As String
Dim FileName As String
Dim nHandle As Integer
Dim nFragmentOffset As Integer
Dim i As Integer
Dim lOffset As Long
Dim lSize As Long
Dim lSubChunks As Long
Dim lChunks As Long
Dim Chunk() As Byte
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Path)
Set fc = f.Files
For Each f1 In fc
FileName = f1.Name
FullPath = Path & FileName
nHandle = FreeFile
Open FullPath For Binary Access Read As nHandle
lSize = LOF(nHandle)
If nHandle = 0 Then
Close nHandle
End If
lChunks = lSize \ conChunkSize
nFragmentOffset = lSize Mod conChunkSize
rs.AddNew
ReDim Chunk(nFragmentOffset)
Get nHandle, , Chunk()
rs("Large Image").AppendChunk Chunk()
ReDim Chunk(conChunkSize)
lOffset = nFragmentOffset
For i = 1 To lChunks
Get nHandle, , Chunk()
rs("Large Image").AppendChunk Chunk()
lOffset = lOffset + conChunkSize
DoEvents
Next
rs.Update
Close nHandle
Next
End Sub

You may notice that there is no code in this procedure for opening the table in question, tblCards. This is not an oversight. I have removed that code and placed it in its own procedure and have also created a procedure for closing the table when processing is complete.

Any assistance you can provide is most appreciated.

 

[RuralGuy]

It is sure a lot easier to read if you use the Code Tags "#"

Public Sub AddLargeImage(ByVal Path As String)
    Dim FullPath As String
    Dim FileName As String
    Dim nHandle As Integer
    Dim nFragmentOffset As Integer
    Dim i As Integer
    Dim lOffset As Long
    Dim lSize As Long
    Dim lSubChunks As Long
    Dim lChunks As Long
    Dim Chunk() As Byte
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Path)
    Set fc = f.Files
    For Each f1 In fc
        FileName = f1.Name
        FullPath = Path & FileName
        nHandle = FreeFile
        Open FullPath For Binary Access Read As nHandle
        lSize = LOF(nHandle)
        If nHandle = 0 Then
            Close nHandle
        End If
        lChunks = lSize \ conChunkSize
        nFragmentOffset = lSize Mod conChunkSize
        rs.AddNew
        ReDim Chunk(nFragmentOffset)
        Get nHandle, , Chunk()
        rs("Large Image").AppendChunk Chunk()
        ReDim Chunk(conChunkSize)
        lOffset = nFragmentOffset
        For i = 1 To lChunks
            Get nHandle, , Chunk()
            rs("Large Image").AppendChunk Chunk()
            lOffset = lOffset + conChunkSize
            DoEvents
        Next
        rs.Update
        Close nHandle
    Next
End Sub