当前无法显示此图像

yydpj 2013-10-25 09:46:40

Option Explicit
Private Sub CommandButton1_Click()
Const HeaderSize As Long = 78
Const ChunkSize As Long = 100
Dim TempFile As String
Dim FileNumber As Integer
Dim sConnString As String
Dim conn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim byteChunk() As Byte
Dim Totalsize As Long
Dim FieldSize As Long
Dim lCount As Integer

On Error GoTo ErrHandler:
sConnString = "Provider=SQLOLEDB.1;Server=80ISCALA;Database=ScalaDB;Trusted_Connection=yes;"
conn.Open sConnString
Set rst = New ADODB.Recordset
rst.Open "select * from ZZ003 where ZZ003.SC01001 ='E5001A'", conn, adOpenKeyset, adLockPessimistic
' 移至第一条记录
rst.MoveFirst
Set fld = rst.Fields("ItemPicture")
Do While Not rst.EOF
FieldSize = fld.ActualSize
lCount = lCount + 1
TempFile = "TempFile" & lCount & ".Temp"

FileNumber = FreeFile
Open TempFile For Binary Access Write As FileNumber
Totalsize = FieldSize - HeaderSize ' Substract it from the total size.
byteChunk() = fld.GetChunk(HeaderSize) ' Get rid of the header.
byteChunk() = fld.GetChunk(Totalsize)
Put FileNumber, , byteChunk()
Close FileNumber

Cells(lCount, 1).Activate
ActiveSheet.Pictures.Insert TempFile
Kill (TempFile)

rst.MoveNext
Loop
Exit Sub
ErrHandler:
MsgBox Err.Description, , "Error "

End Sub

...全文