I don't have the right version of access to test this, but should be close.
Need to add a reference to ADO in the Excel VB project.
Tim
Sub Access_Data()
Dim picPath As String
Dim oStream As New ADODB.Stream
Dim conn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim strPath As String
Dim sql As String
Dim rngDest As Range
Set rngDest = ActiveSheet.Range("D3")
sql = "select pic from tblPics where id=1"
strPath = ThisWorkbook.Path & "\Pics.mdb"
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & strPath & ";"
conn.CursorLocation = adUseClient
Set rst = conn.Execute(sql)
If Not rst.EOF Then
picPath = ThisWorkbook.Path & "\temp.jpg"
oStream.Type = adTypeBinary
oStream.Open
oStream.Write rst.Fields("pic").Value
oStream.SaveToFile picPath, adSaveCreateOverWrite
oStream.Close
rngDest.Parent.Pictures.Insert(picPath).Select
With Selection
.ShapeRange.Top = rngDest.Top
.ShapeRange.Left = rngDest.Left
End With
End If
rst.Close
conn.Close
End Sub
