Storing .jpg in Access

When .jpg is stored in an access database it is first rendered (turned into a .bmp/dib) and this rendering is stored with it - removing any storage advantage gained from converting the picture to .jpg - an important consideration given access's limit of 1Gb per mdb.


To overcome this, I renamed my .jpg files to .jpx files before inserting to the ole field. OK so far. Now I use a vb program to retrieve the records, data control and ole container. The image appears as an Icon in the ole container. Right clicking gives me the option to 'Edit Package'. I thus use the Object Packager to save my retrieved .jpx file to a file "picfile.jpg". I have an image control image1 on the form into which I load the picture with the following code behind the command button "image1.picture = LoadPicture("c:\abc\picfile.jpg")


I have achieved what I want ie Store a photograph in Access in .jpg format without the storage overhead of also storing the rendered image and be able to retrieve that photo and display it. (I do not want to store the .jpg in a directory and a referencein the db)


What I really want is to do all this in code - any ideas?

I could not understand your question very well...but what i could get is that
u want to store a JPEG pic in your access Database!!!!U don't want the Ref.
in the database but the image to be stored in access Database itself.....is i
am correct with what i say...then below is a piece of code which will help u
to solve your problem...Do check it:):)

Code:

---

'delete the temp file if it is already there
 Kill GetTemporaryDirectory() & TEMPIMAGEFILENAME
       
 'convert the ole object into a file
 'Here Logo is a field in the table of type OLE
 Call BlobToFile(objRecordSet.Fields("Logo"), GetTemporaryDirectory() & TEMPIMAGEFILENAME)
   
 'load the image box
 imgLogo.Picture = LoadPicture(GetTemporaryDirectory() & TEMPIMAGEFILENAME)
   
  If Not Dir(GetTemporaryDirectory() &  TEMPIMAGEFILENAME) = "" Then Kill GetTemporaryDirectory() & TEMPIMAGEFILENAME
  Call SavePicture(imgLogo.Picture, GetTemporaryDirectory() & TEMPIMAGEFILENAME)
  imgLogo.Picture = LoadPicture(GetTemporaryDirectory() & TEMPIMAGEFILENAME)
    'update the record set
    cmdLogo.Tag = GetTemporaryDirectory() & TEMPIMAGEFILENAME

'Below is a MOD..Please Insert the below code in a module
Option Explicit

      Const BLOCK_SIZE = 16384

      Sub BlobToFile(fld As ADODB.Field, ByVal FName As String, _
                    Optional FieldSize As Long = -1, _
                    Optional Threshold As Long = 1048576)
      '
      ' Assumes file does not exist
      ' Data cannot exceed approx. 2Gb in size
      '
      Dim F As Long, bData() As Byte, sData As String
        F = FreeFile
        Open FName For Binary As #F
        Select Case fld.Type
          Case adLongVarBinary
            If FieldSize = -1 Then  ' blob field is of unknown size
              WriteFromUnsizedBinary F, fld
            Else                    ' blob field is of known size
              If FieldSize > Threshold Then  ' very large actual data
                WriteFromBinary F, fld, FieldSize
              Else                            ' smallish actual data
                bData = fld.Value
                Put #F, , bData  ' PUT tacks on overhead if use fld.Value
              End If
            End If
          Case adLongVarChar, adLongVarWChar
            If FieldSize = -1 Then
              WriteFromUnsizedText F, fld
            Else
              If FieldSize > Threshold Then
                WriteFromText F, fld, FieldSize
              Else
                sData = fld.Value
                Put #F, , sData  ' PUT tacks on overhead if use fld.Value
              End If
            End If
        End Select
        Close #F
      End Sub

      Sub WriteFromBinary(ByVal F As Long, fld As ADODB.Field, _
                          ByVal FieldSize As Long)
      Dim Data() As Byte, BytesRead As Long
        Do While FieldSize <> BytesRead
          If FieldSize - BytesRead < BLOCK_SIZE Then
            Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
            BytesRead = FieldSize
          Else
            Data = fld.GetChunk(BLOCK_SIZE)
            BytesRead = BytesRead + BLOCK_SIZE
          End If
          Put #F, , Data
        Loop
      End Sub

      Sub WriteFromUnsizedBinary(ByVal F As Long, fld As ADODB.Field)
      Dim Data() As Byte, Temp As Variant
        Do
          Temp = fld.GetChunk(BLOCK_SIZE)
          If IsNull(Temp) Then Exit Do
          Data = Temp
          Put #F, , Data
        Loop While LenB(Temp) = BLOCK_SIZE
      End Sub

      Sub WriteFromText(ByVal F As Long, fld As ADODB.Field, _
                        ByVal FieldSize As Long)
      Dim Data As String, CharsRead As Long
        Do While FieldSize <> CharsRead
          If FieldSize - CharsRead < BLOCK_SIZE Then
            Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
            CharsRead = FieldSize
          Else
            Data = fld.GetChunk(BLOCK_SIZE)
            CharsRead = CharsRead + BLOCK_SIZE
          End If
          Put #F, , Data
        Loop
      End Sub

      Sub WriteFromUnsizedText(ByVal F As Long, fld As ADODB.Field)
      Dim Data As String, Temp As Variant
        Do
          Temp = fld.GetChunk(BLOCK_SIZE)
          If IsNull(Temp) Then Exit Do
          Data = Temp
          Put #F, , Data
        Loop While Len(Temp) = BLOCK_SIZE
      End Sub

      Sub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
                    Optional Threshold As Long = 1048576)
      '
      ' Assumes file exists
      ' Assumes calling routine does the UPDATE
      ' File cannot exceed approx. 2Gb in size
      '
      Dim F As Long, Data() As Byte, FileSize As Long
        F = FreeFile
        Open FName For Binary As #F
        FileSize = LOF(F)
        Select Case fld.Type
          Case adLongVarBinary
            If FileSize > Threshold Then
              ReadToBinary F, fld, FileSize
            Else
              Data = InputB(FileSize, F)
              fld.Value = Data
            End If
          Case adLongVarChar, adLongVarWChar
            If FileSize > Threshold Then
              ReadToText F, fld, FileSize
            Else
              fld.Value = Input(FileSize, F)
            End If
        End Select
        Close #F
      End Sub

      Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
                      ByVal FileSize As Long)
      Dim Data() As Byte, BytesRead As Long
        Do While FileSize <> BytesRead
          If FileSize - BytesRead < BLOCK_SIZE Then
            Data = InputB(FileSize - BytesRead, F)
            BytesRead = FileSize
          Else
            Data = InputB(BLOCK_SIZE, F)
            BytesRead = BytesRead + BLOCK_SIZE
          End If
          fld.AppendChunk Data
        Loop
      End Sub

      Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
                    ByVal FileSize As Long)
      Dim Data As String, CharsRead As Long
        Do While FileSize <> CharsRead
          If FileSize - CharsRead < BLOCK_SIZE Then
            Data = Input(FileSize - CharsRead, F)
            CharsRead = FileSize
          Else
            Data = Input(BLOCK_SIZE, F)
            CharsRead = CharsRead + BLOCK_SIZE
          End If
          fld.AppendChunk Data
        Loop
      End Sub


Public Function GetTemporaryDirectory() As String
' Purpose            : to get the systems temporary path
' Description        : uses the gettemppath api to get the systems temp path
=================================================

    Dim strTempPath As String
   
    strTempPath = Space$(1024)
   
    Call GetTempPath(1024, strTempPath)
    strTempPath = Trim$(strTempPath)
    strTempPath = Left(strTempPath, Len(strTempPath) - 1)
    GetTemporaryDirectory = CleanPath(strTempPath)

End Function

'Code for saving the selected file

    'if an image was specified then save it
    If Not cmdLogo.Tag = "" Then
      If cmdLogo.Tag = "ClearMe" Then
        objRecordSet!Logo = Null
      Else
        Call FileToBlob(cmdLogo.Tag, objRecordSet!Logo, 16384)

      End If
      objRecordSet.Update
      Call CloseRecordSet(objRecordSet)
      Call Sleep(1000)
    End If

---

PLease let me know if any problems


Regards,
Sidds

S/W Developer
India.