Extract 1834 Images from Excel 2007 and Transfer to a Database Table

28 12 2009

December 28, 2009

(Portions of this code are adapted from the book “Excel 2007 Power Programming with VBA”  )

This code sample is an Excel 2007 macro that extracts all of the named toolbar button pictures from Excel 2007, transfers those pictures to an Oracle database (stored in a BLOB), and then retrieves each of the pictures and displays the pictures on an Excel worksheet.

First, we need to create a table to hold the pictures:

CREATE TABLE EXCEL2007_TOOLBAR_PICTURES (
  PICTURE_NAME VARCHAR2(60),
  PICTURE_SIZE NUMBER,
  PICTURE BLOB,
  PRIMARY KEY(PICTURE_NAME));

Download the ExcelImageList.doc file and save it using Microsoft Word as a Plain Text File with the name ExcelImageList.txt in the root of the C:\ drive.

We need to make certain that macro support is enabled in Excel 2007, by default it is disabled.  Follow steps 1 through 3 to verify that the Developer tab appears at the top of the screen:

On the Developer tab, click the Visual Basic button.  We need to add a reference to the Microsoft ActiveX Data Objects to allow the macro to interact with an Oracle database.  From the Tools menu, select References…

Locate one of the recent releases of Microsoft ActiveX Data Objects, select it, then click OK.

Finally, we create the following macro:

Private Sub ExtractAllImages()
    Dim i As Integer
    Dim intResult As Integer
    Dim intFileNum As Integer
    Dim intFileNum2 As Integer
    Dim sglX As Single
    Dim sglY As Single
    Dim strName As String
    Dim strSQL As String
    Dim strDatabase As String
    Dim strUserName As String
    Dim strPassword As String
    Dim bytPicture() As Byte

    Dim imgPicture As OLEObject
    Dim snpData As New ADODB.Recordset
    Dim dynData As New ADODB.Recordset
    Dim dbDatabase As New ADODB.Connection

    On Error Resume Next

    'Remove all of the previously created sheet
    Application.DisplayAlerts = False
    Sheets("BuiltInImages").Delete

    Sheets.Add
    ActiveSheet.Name = "BuiltInImages"

    DoEvents
    Application.DisplayAlerts = True

    If Len(Dir("C:\ExcelBuiltInImages", vbDirectory)) < 4 Then
        'Create the folder to hold the exported pictures
        MkDir "C:\ExcelBuiltInImages"
    End If

    'Create a temporary image object to hold the pictures from GetImageMso
    Set imgPicture = Sheets("BuiltInImages").OLEObjects.Add(classtype:="Forms.Image.1", Left:=800, Top:=1, Width:=32, Height:=32)
    With imgPicture.Object
        .AutoSize = True
        .BorderStyle = 0
    End With

    Err = 0
    intFileNum = FreeFile
    Open "C:\ExcelImageList.txt" For Input As #intFileNum

    If Err <> 0 Then
        intResult = MsgBox("Could not open the image list file." & vbCrLf & Error(Err), 16, "Excel Demo")
        Exit Sub
    End If

    strDatabase = "MyDB" 'From tnsnames.ora
    strUserName = "MyUserID"
    strPassword = "MyPassword"

    'Connect to the database
    'Oracle connection string
    dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

    dbDatabase.ConnectionTimeout = 40
    dbDatabase.CursorLocation = adUseClient
    dbDatabase.Open

    If (dbDatabase.State <> 1) Or (Err <> 0) Then
        intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")
    End If

    'The table definition
    'CREATE TABLE EXCEL2007_TOOLBAR_PICTURES (
    '  PICTURE_NAME VARCHAR2(60),
    '  PICTURE BLOB,
    '  PRIMARY KEY(PICTURE_NAME));

    If Err = 0 Then
        'Remove pictures that were previously brought in
        strSQL = "DELETE FROM EXCEL2007_TOOLBAR_PICTURES"
        dbDatabase.Execute strSQL

        dbDatabase.BeginTrans

        'Prepare to add the new pictures to the database
        strSQL = "SELECT"
        strSQL = strSQL & "  PICTURE_NAME," & vbCrLf
        strSQL = strSQL & "  PICTURE_SIZE," & vbCrLf
        strSQL = strSQL & "  PICTURE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  EXCEL2007_TOOLBAR_PICTURES"
        dynData.Open strSQL, dbDatabase, adOpenKeyset, adLockOptimistic, adCmdText

        'Process each of the toolbar picture names from the text file
        Do While Not (EOF(intFileNum))
            i = i + 1
            'Read a toolbar picture name from the text file
            Line Input #intFileNum, strName
            Application.StatusBar = strName

            'Set the picture in the temporary image object, and then save to disk
            imgPicture.Object.Picture = Application.CommandBars.GetImageMso(strName, 32, 32)
            SavePicture imgPicture.Object.Picture, "C:\ExcelBuiltInImages\temp.bmp"

             'Create a new row in the table
            dynData.AddNew
            dynData("picture_name") = strName & ".bmp"
            dynData("picture_size") = FileLen("C:\ExcelBuiltInImages\temp.bmp")

            'Read the picture into the table
            intFileNum2 = FreeFile
            Open "C:\ExcelBuiltInImages\temp.bmp" For Binary As #intFileNum2

            'Prepare a variable of byte data type to hold the picture read from disk
            ReDim bytPicture(FileLen("C:\ExcelBuiltInImages\temp.bmp"))
            Get #intFileNum2, , bytPicture
            Close #intFileNum2

            'Write the picture into the table and save the row
            dynData.Fields("picture").AppendChunk bytPicture
            dynData.Update

            'Delete the picture from the folder
            Kill "C:\ExcelBuiltInImages\temp.bmp"
        Loop
        Application.StatusBar = ""

        dbDatabase.CommitTrans

        dynData.Close

        Close #intFileNum

        'Remove the temporary image object
        imgPicture.Delete

        'Retrieve the pictures from the database and display in Excel
        i = 0
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  PICTURE_NAME," & vbCrLf
        strSQL = strSQL & "  PICTURE_SIZE," & vbCrLf
        strSQL = strSQL & "  PICTURE" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  EXCEL2007_TOOLBAR_PICTURES" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  PICTURE_NAME"
        snpData.Open strSQL, dbDatabase

        If Not (snpData.EOF) Then
            Do While Not (snpData.EOF)
                i = i + 1
                Application.StatusBar = snpData("picture_name")

                'Retrieve the picture from the database and write to a file

                ReDim bytPicture(snpData("picture_size"))
                bytPicture = snpData("picture")
                intFileNum2 = FreeFile
                Open "C:\ExcelBuiltInImages\" & snpData("picture_name") For Binary As #intFileNum2
                Put #intFileNum2, , bytPicture
                Close #intFileNum2

                'There will be 20 pictures across the page, so identify the top left position of the picture
                sglX = ((i - 1) Mod 20) * 36
                sglY = Int((i - 1) / 20) * 36

                'Create the shape object and load the picture that was saved from the image object
                With Sheets("BuiltInImages").Shapes.AddShape(Type:=msoShapeRectangle, Left:=sglX, Top:=sglY, Width:=30, Height:=30)
                    .Line.Visible = False
                    .Fill.UserPicture "C:\ExcelBuiltInImages\" & snpData("picture_name")
                    .AlternativeText = snpData("picture_name")
                End With

                'Allow Excel to refresh the screen as every four rows complete
                If i Mod 80 = 0 Then
                    Application.ScreenUpdating = True
                    DoEvents
                    Application.ScreenUpdating = False
                End If

                snpData.MoveNext
            Loop
            snpData.Close
        End If
    End If
    Application.ScreenUpdating = True
    Application.StatusBar = ""
    dbDatabase.Close

    'Clean up
    Set snpData = Nothing
    Set dynData = Nothing
    Set dbDatabase = Nothing
    Set imgPicture = Nothing
End Sub

When the macro runs, it saves each of the built-in toolbar icons to a file named temp.bmp, and then inserts a row into the database table with the temp.bmp picture.  Once all of the pictures are stored in the database, a query is run to retrieve each of the pictures, create a file in ExcelBuiltInImages folder for that picture, and then display the picture in Excel.  The screen is refreshed after every 80 pictures are displayed.  Note that most of the built-in toolbar icons are designed to be viewed at a size of 16 pixels by 16 pixels, rather than 32 pixels by 32 pixels – so the images may appear a bit “blocky”.  The picture filenames are stored in the Alt Text property of each picture, which may be viewed by right-clicking a picture and selecting Size and Properties…

After the macro runs, the new worksheet will look something like the picture below:

Since the pictures are also saved to a file, they are ready to be used for other purposes:


Actions

Information

5 responses

20 01 2010
Paul D Pruitt

Charles,

Hi, I admire your posts even though I don’t have Oracle. I’m in need of the images from the Quick Access Toolbar-QAT commands for Word, Excel and PowerPoint. Can you make these available in Excel spreadsheet form for download?

Thanks for considering this,

Paul Pruitt

20 01 2010
Charles Hooper

The above code should extract those icons for you – just eliminate the code related to the database access. The critical lines are #37 (change the size from 32 x 32 to 16 x 16) and lines 44-45 and lines 91-99. You might also want to look at the code in this blog article:
https://hoopercharles.wordpress.com/2009/12/28/extract-the-first-4400-images-from-excel-2003-and-above-and-transfer-to-a-database-table/

I believe this this book might be helpful for you – there is an interesting browser for the toolbar icons on the accompanying CD:

21 01 2010
Paul D Pruitt

Charles,

Thanks so much for your feedback. I actually did something better I downloaded Oracle Express and once I got the two references Microsoft ActiveX Data Objects and Microsoft ActiveX Data Objects RecordSet Library (I think I needed both) and then changed the code to enter my database name (automatically named “XE” for Express) , my username (“system” as mentioned in setup) and password as set in during install, it worked smoothly. I earlier had created the table in Oracle once I figured out I need to connect to the database first in the SQL CMD interface.

So now I have the Excel spreadsheet as described. I also have the directory filled with images with the right names, which is actually more valuable. So now my problem is getting the images in the table in the correct rows that also have the QAT the respective command name. This though is my problem, you’ve done your part! Thanks so much! I spent two days looking for a solution to this problem.

23 01 2010
Paul D Pruitt

I was able to insert the images in my proper rows using a macro I found, although it was much less elegant as I used one line of code for each image.

My new problem is how to rewrite your code for extracting Word and PowerPoint QAT commands. If you have any suggestions, let me know.

23 01 2010
Charles Hooper

You might find some useful information on this site (located through a Google search, so I do not know the quality of the information):
http://blogs.msdn.com/jensenh/archive/2006/09/15/755336.aspx

The “Download Office 2007 B2TR Control ID List” file apparently contains the control names that need to be passed into the GetImageMso function (in place of strName) – it looks like the download includes the control names for Access, Excel, Outlook, Power Point, and Word.

Good luck.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s




Follow

Get every new post delivered to your Inbox.

Join 137 other followers

%d bloggers like this: