Solved

Saving Access OLE Object Bitmaps to BMP files

Posted on 2010-08-21
15
1,335 Views
Last Modified: 2012-05-10
Hello:
I have an Access table containing an OLE Object field called "Image", and each record contains a small bitmap image.  I'm having trouble finding the VB command to export these to a series of BMP files.  

The table also contains a "name" field identifying who the image is.  My intention is to use the Name field to dictate the name of the file to which I will save each image.  If, for example, the names were Arnie, Betty, and Cammie, and I wanted to save the images into the C:\Images\ directory, I would expect to the process to finish with these three files:

C:\Images\Arnie.bmp; C:\Images\Betty.bmp; C:\Images\Cammie.bmp

I've include a code block that shows my progress thus far.  Thanks, in advance, for your assistance with this.
~Peter Ferber

Sub MigrateImages()

    Dim MyDB As Database

    Dim MyRcd As DAO.Recordset

    

    Dim strsql As String

    

    Set MyDB = CurrentDb

    strsql = _

        "Select" & vbcrlf & _

        "    Image" & vbcrlf & _

        ",   Name" & vbcrlf & _

        "FROM" & vbcrlf & _

        "    tblImages"

    Set MyRcd = MyDB.OpenRecordset(strsql, dbOpenDynaset)

    If (Not (MyRcd.BOF And MyRcd.EOF)) Then

        MyRcd.MoveFirst

        While (Not MyRcd.EOF)

            <Code to export images goes here>

        Wend

    End If

End Sub

Open in new window

0
Comment
Question by:PeterFrb
  • 10
  • 4
15 Comments
 

Author Comment

by:PeterFrb
ID: 33493619
I will do you one better.  I've provided a slightly updated code block with the name of the file to export.
~Peter Ferber

Sub MigrateImages()

    Dim MyDB As Database

    Dim MyRcd As DAO.Recordset

    

    Dim strsql As String

    Dim strExport As String

    

    Set MyDB = CurrentDb

    strsql = _

        "Select" & vbcrlf & _

        "    Image" & vbcrlf & _

        ",   Name" & vbcrlf & _

        "FROM" & vbcrlf & _

        "    tblVenue_Images" 

    Set MyRcd = MyDB.OpenRecordset(strsql, dbOpenDynaset)

    If (Not (MyRcd.BOF And MyRcd.EOF)) Then

        MyRcd.MoveFirst

        While (Not MyRcd.EOF)

            strExport = "C:\Images\" & MyRcd("Name") & ".bmp"

            <Code to export images goes here>

        Wend

    End If

End Sub

Open in new window

0
 
LVL 20

Accepted Solution

by:
GrahamMandeno earned 500 total points
ID: 33493988
Hi Peter
I think this might be what you are looking for...
http://www.lebans.com/oletodisk.htm
--
Graham
0
 

Author Comment

by:PeterFrb
ID: 33494091
Not bad, although it doesn't work.  It can't find a DLL reference.  Although I would prefer to know how to do the work myself, as it were, lifting the veil underneath the DLL.
I have attached an image of the error message I get.
Thanks, ~Peter
ExportProgram-Error.bmp
0
 

Author Comment

by:PeterFrb
ID: 33494100
Actually, I may be able to salvage this...I am looking at the code, which appears to actually do the work.  I may give credit for this answer yet!  Stand by.
~Peter
0
 

Author Comment

by:PeterFrb
ID: 33494129
I'm having a lot of trouble with this form, I'm getting errors and having trouble that I can not overcome.
I would like to see a straightforward set of code to do the work.
Thanks, ~Peter
0
 

Author Comment

by:PeterFrb
ID: 33494206
I did some more searching, and I found what I'd hoped would be a straightforward solution to the problem:

http://forums.devx.com/showthread.php?t=125560

Using this site as a template, I devised a new set of code, and although the technique produces files, they are not viable bitmap files.  Am still searching for that elusive code, although I hope and suspect that my new technique comes closer than what else I've tried so far.
Thanks, ~Peter

Sub MigrateImages()

    Dim MyADOConnect As ADODB.Connection

    Dim MyADORcd As New ADODB.Recordset

    Dim MyStream As ADODB.Stream

    

    Dim MyDB As Database

    Dim MyRcd As DAO.Recordset

    

    Dim strsql As String

    Dim strExportFile As String

    Dim strExportContent As String

    

    Dim lngCount As Long

    

    Dim iTest As Integer

    

    Dim UseBytes() As Byte

    

    Set MyADOConnect = CurrentProject.Connection

    strsql = _

        "Select" & vbcrlf & _

        "    Image" & vbcrlf & _

        ",   Name" & vbcrlf & _

        "FROM" & vbcrlf & _

        "    tblVenue_Images"

    MyADORcd.Open strsql, MyADOConnect

    If (Not (MyADORcd.BOF And MyADORcd.EOF)) Then

        MyADORcd.MoveFirst

        Set MyStream = New ADODB.Stream

        MyStream.Type = adTypeBinary

        While (Not MyADORcd.EOF)

            MyStream.Open

            strExportFile = "C:\Images\" & MyADORcd("Name") & ".bmp"

            MyStream.Write MyADORcd("Image").Value

            MyStream.SaveToFile strExportFile

            MyStream.Close

            MyADORcd.MoveNext

        Wend

    End If

End Sub

Open in new window

0
 
LVL 44

Expert Comment

by:GRayL
ID: 33496207
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:PeterFrb
ID: 33497303
Thank you, GRayL.  I'm willing to try anything thrown my way to get this to work, and I've created a second version of my program, based on this link.  Your version uses the mysterious "TrimFile" function, which I don't really understand and had an error in the original version ('Bytes(3) = "K"' instead of 'Bytes(3) = Asc("K")', which I changed).  

I now get an error in the TrimFile function, right after the "Next lngCount" routine.  My code goes through the entire loop without exiting, and when it gets to "ReDim bytes(LOF(iFile) - lngCount)", lngCount is one greater than LOF(IFile)).  I don't believe the writers intend or expect this to happen, and I think it balks at a dimensioning of -1.  

I now have two copies of the routine installed, neither of which is working for me.  I appreciate your continued efforts to solve this problem.
All the best, ~Peter Ferber

Sub MigrateImages2()

    Dim MyDB As Database

    Dim MyRcd As DAO.Recordset

    

    Dim strsql As String

    Dim strExportFile As String

    Dim strExportContent As String

    

    Dim lngCount As Long

    

    Dim iTest As Integer

    Dim iFile As Integer

    

    Dim UseBytes() As Byte

    

    Set MyDB = CurrentDb

    strsql = _

        "Select" & vbcrlf & _

        "    Image" & vbcrlf & _

        ",   Name" & vbcrlf & _

        "FROM" & vbcrlf & _

        "    tblVenue_Images" 

    Set MyRcd = MyDB.OpenRecordset(strsql, dbOpenDynaset)

    If (Not (MyRcd.BOF And MyRcd.EOF)) Then

        MyRcd.MoveFirst

        While (Not MyRcd.EOF)

            strExportFile = "C:\Images\" & MyRcd("Name") & ".bmp"

            UseBytes = MyRcd("Image").Value

            iFile = FreeFile

            

            Call MyUniversalClass.DeleteFile(strExportFile)

            Open strExportFile For Binary Access Write As #iFile

            Put #iFile, , UseBytes

            Close #iFile

            Call TrimFile(strExportFile)

            MyRcd.MoveNext

        Wend

    End If

End Sub



Sub TrimFile(ByVal fname As String)

    Dim bytes() As Byte

    Dim lngCount As Long

    Dim iFile As Integer

    

    ReDim bytes(4)

    iFile = FreeFile

    Open fname For Binary As #iFile

    For lngCount = 1 To LOF(1)

        Seek #iFile, lngCount

        Get #iFile, , bytes

        If bytes(0) = Asc("B") And bytes(1) = Asc("M") And bytes(2) = Asc("B") And bytes(3) = Asc("K") Then Seek #iFile, lngCount: Exit For

    Next lngCount

    ReDim bytes(LOF(iFile) - lngCount)

    Get #iFile, , bytes

    Close #iFile

    

    iFile = FreeFile

    Open fname For Binary As #iFile

    Put #iFile, , bytes

    Close #iFile

End Sub

Open in new window

0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 33497612
Hi Peter

Sorry I didn't get back sooner.

Which of Stephen Lebans' zip files did you download?  Was it ExtractInventoryOLE.zip?  If so, it doesn't require StrStorage.dll - only a cut-down version named SSGetContents.dll, which is in that zip file.  You don't need to register the DLL - just put it in the same folder as you MDB project.  (I think if SSGetContents.dll is missing then you will get a message complaining about StrStorage.dll.  Stephen is a genius, but he didn't always pay a lot of attention to "unimportant" details such as the wording of error messages!!)

That solution extracts almost any type of OLE object from the table field - not just bitmap pictures.

There is another link on the same page - http://www.lebans.com/DownloadFiles/ExportOLEtoJpegVer16.zip - which saves embedded picture objects as JPGs.

I don't think it is feasible to simply read the data from the table field and write it to a file, which is what the other solution appear to be doing.  As you have observed, you get a file with some data in it, but the file is not a valid BMP.

--
Graham.
0
 

Author Comment

by:PeterFrb
ID: 33498466
I'm using ExtractInventoryOLEv89.mdb, and I'm trying out the interface from this program.  I have copied SSGetContents.dll to c:\Windows\System32\ folder, as the directions say, and in the same directory as my MDB file, as you say.  Using the provided form, I get an error whenever I press the button marked "Select MDB..." and say OK.  The code calls lstTableNames_AfterUpdate, and when the first invoked command is "TableName = lstTableNames.Value", which fails because I have not yet populated lstTableNames, and the value returns null, which is invalid for a string.  
I'm unclear why cmdSelect_Click calls lstTableNames_AfterUpdate, since one clearly populates the MDB file before selecting a Table/Query.  
I'm trying to do it by the procedure the program is giving me, and that, too, is failing.  
If this helps at all, I created these fields by copying an image and then pasting the image from the clipboard when my cursor occupied the field.  I wonder if my technique causes one to treat the field differently than if it were somehow referencing the bitmap file directly.  I don't know: I'm just fishing for possible clues.
Thanks, ~Peter Ferber
0
 

Author Comment

by:PeterFrb
ID: 33498890
One more clue I just noticed.  When I go to the table itself, I can manually right click on the Bitmap field, and choose "Edit" or "Open", both of which open a copy of the file in the Paint program.  Generaly speaking, manual functions have coding correlaries, and it seems that facilitating the same manual process, if that's possible, is easier than tryng to convert the raw text field into the equivalent BMP file.  Any thoughts on taking this approach?
Best, ~Peter
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 33499000
After selecting a database file, the code populates lstTableNames with the names of all the tables in hat database which contain one or more OLE object fields.  Then it selects the first of these tables and calls lstSelectTables_AfterUpdate to populate the next two comboboxes.  lstOLEFields is filled with all the OLE fields in the selected table and lstNames if filled with all the non-OLE fields.
I don't know why Stephen chose to auto-select the first table - perhaps because it's likely there will be only one table with an OLE field in your database.
What must be happening is that you have selected a database that does not contain any tables with OLE fields.  Is this correct?  This certainly does generate the "Invalid use of Null" error that you are seeing.
If your database DOES contain at least one table with an OLE field, then something is amiss.  hat version is the database?
All of the table and field selection is unnecessary, by the way.  All tht is required is for you to set the following properties:  MDBName, TableName, OleFieldName, NameField and SaveFolderName.  Then call the code it the Sub ExportOLE, in the module of the form ExtractInventoryAllOLEobjectsFromTable.
Personally, I would move ExportOLE out into modListTables and make it Public.  Then you can just set the five properties mentioned above an call ExportOLE.
--
Graham
0
 

Author Closing Comment

by:PeterFrb
ID: 33504172
2nd times the charm.  Thanks for your continued support in this!  Who knows why it didn't work the first time.
0
 

Author Comment

by:PeterFrb
ID: 33504193
Who knew?  After looking at the problems you described, I decided to re-import the file and try again.  Zip!  Output without fuss or muss, and fast too.
Thanks for hanging in there with the twists and turns.  It's gratifying when it finally happens, and I'm glad to know of this technology.
Best, ~Peter Ferber
0
 
LVL 20

Expert Comment

by:GrahamMandeno
ID: 33506738
Hi Peter
I'm very glad you got it all working.
Good luck!
--
Graham
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now