Nate Oliver's blog

In the spirit of yesterday's entry, let's keep the interop possibilities flowing. Yesterday, we moved a lot of data from Access to Excel. Today, we're going move an image. 

The image in question, for this experiment, is buried in an Access DB Form named 'MyLogo'. In order to do this, we'll need to write some code - Fortunately, I have some... Let's look at it.

Before we start, for this experiment, we want to move 'Image1' from 'MyLogo' to be right-aligned with G4 as the top cell, in a new Workbook. The names in this code of your Image & Form are critical.

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" ( _
    ByVal lpFileName As String) As Long

'Temporary location for picture
Private Const MyLogo = "C:\temp\MyLogo.Emf"

Sub foo()
' Example grabs Image1 from Form: MyLogo
' Original Code and credit to Stephen Lebans
' Tweaked by Nate Oliver for Excel import

Dim fNum As Long ' Hold next File#
' Byte arrays to hold the PictureData prop
Dim bArray() As Byte, cArray() As Byte
Dim lngRet As Long

' Excel & pic late bind vars
Dim myPic As Object
Dim xlApp As Object, xlWb As Object, xlWs As Object

DoCmd.Echo False, "Hold Up"
DoCmd.OpenForm "MyLogo", acNormal, , , acFormEdit
' Resize to hold entire PictureData prop
ReDim bArray(LenB(Forms!MyLogo.Image1.PictureData) - 1)
' Resize to hold the EMF wrapped in the PictureData prop
ReDim cArray(LenB(Forms!MyLogo.Image1.PictureData) - (1 + 8))
' Copy to our array
bArray = Forms!MyLogo.Image1.PictureData
DoCmd.Close acForm, "MyLogo", acSaveNo
DoCmd.Echo True, False

' Copy the embedded EMF - SKIP first 8 bytes
For lngRet = 8 To UBound(cArray) ' - (1) '+ 8)
    cArray(lngRet - 8) = bArray(lngRet)
Next

' Get next avail file handle
fNum = FreeFile
' Let's Create/Open our new EMF File.
Open MyLogo For Binary As fNum
' Write out the EMF FileHeader
Put fNum, , cArray
' Close the File
Close fNum

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add(1)
Set xlWs = xlWb.Worksheets(1)

Set myPic = xlWs.Pictures.Insert(MyLogo)
With myPic
    .Top = xlWs.Range("G4").Top
    .ShapeRange.Height = _
        xlWs.Range("G4").RowHeight * 6 + 1 '6 rows tall
    .Left = xlWs.Range("G4").Left _
        - .Width + 1 'Right align at G
End With

Call DeleteFile(MyLogo)

xlApp.Visible = True
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

End Sub

Note, I've given Stephen Leban's most of the credit for writing this - as he did. If anything, I want to preserve this... I layered in steps to change his original code from a Table-play to a Form-play, and push it into Excel with the sizing and location we want.

Now, why am I using DeleteFile(), an API Call, instead of Kill? Kill will actually bomb on this if the file is still open for editing, and it runs fast enough where it will trip-up.

What's the overall spirit of this? No one has ever asked me how to do this - I wanted to know. I wanted to create great-looking Excel-based reports - I needed the company logo to be right-aligned on the right end of the report. And I wanted to keep everything, the data, images, code, in one location: A single Access DB.

So there it is, another Access/Excel interop possibility!