Use ADO to copy a graphic to Access from XL

[quartz]

I am using Office 2003 on Win XP.

I normally use ADO to transfer data from Excel to Access. Does anyone know
if you can use ADO to transfer a graphical object laying on a spreadsheet to
Access?

In this case, the object is a chart copied from the internet. If it can't be
done using ADO, how can it be done programmatically?

Can you please post example code? Thanks much in advance.

[michelxld]

Hello Quartz

I hope this help you



Option Explicit
Public Const BLOCK_SIZE = 10000
Public Cn As New ADODB.Connection

Sub exportGraphic()
'**************************************************
'adapted from source : http://www.vbfrance.com/code.aspx?ID=26014
'**************************************************
'
Dim Rs As New ADODB.Recordset
Dim Pict As Picture
Dim FichierTemp As String
Dim Nb As Byte

FichierTemp = ThisWorkbook.Path & "\PictTemp.jpg"

On Error GoTo ShowError:

Set Pict = ActiveSheet.Pictures(1) 'graphical object : first picture in sheets(1)
Pict.CopyPicture ' copy
With ActiveSheet.ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart ' create temporary chart
.Paste 'paste in the chart
.Export FichierTemp, "JPG" ' save temporary jpg file on disk
End With

Nb = ActiveSheet.ChartObjects.Count
ActiveSheet.ChartObjects(Nb).Delete 'delete temporary chart

'export jpg temporary file in a Access database named "Images"
'for this example you need 3 fields in the dataBase :
'PicId ( numeric data )
'Pic ( binay data )
'PicSize (numeric data)
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& "C:\Images.mdb"

Rs.CursorLocation = adUseClient
Rs.Open "Select * From Pictures", Cn, adOpenDynamic, adLockOptimistic

With Rs
.AddNew
!PicId = .RecordCount
exportImage FichierTemp, Rs, "Pic", "PicSize"
.Update
End With

Rs.Close
Cn.Close
MsgBox "Image Saved"

Kill FichierTemp 'delete temporary jpg file
Exit Sub

ShowError:
MsgBox Err.Description
End Sub


Public Sub exportImage(filename As String, rstMain As Recordset, _
FieldName As String, SizeField As String)

Dim file_num As String
Dim file_length As Long
Dim bytes() As Byte
Dim num_blocks As Long, left_over As Long, block_num As Long

On Error GoTo Handler

file_num = FreeFile

Open filename For Binary Access Read As #file_num
file_length = LOF(file_num)
If file_length > 0 Then
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE

rstMain(SizeField) = file_length

ReDim bytes(BLOCK_SIZE)

For block_num = 1 To num_blocks
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
Next block_num

If left_over > 0 Then
ReDim bytes(left_over)
Get #file_num, , bytes()
rstMain(FieldName).AppendChunk bytes()
End If
Close #file_num
End If

Exit Sub

Handler:
MsgBox Err.Description
End Sub



Regards ,
michel

[michelxld]

Hello Quartz

sorry ,

I wanted to write :

'for this example you need 3 fields in the dataBase , named :
'PicId ( numeric data )
'Pic ( OleObject data )
'PicSize (numeric data)


Regards
michel