当前无法显示此图像

[yydpj]

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

[yydpj]

放在"其他开发语言 >Office开发/ VBA" 无人问津

[yydpj]

[舉杯邀明月]

你存入数据库后，读取出来的数据是否跟原始数据一致呢？ 你可以先用一个小图片，来比较下文件数据呀。

[舉杯邀明月]

引用 1 楼 yydpj 的回复:

放在"其他开发语言 >Office开发/ VBA" 无人问津

本来人气就差，再加上有不少解决问题不结贴的，又造成“负能量”

[舉杯邀明月]

还有一个问题是：是不是因为你把图片文件删除了的缘故？ 你试一下把“Kill (TempFile)”去掉，结果如何。

[yydpj]

谢谢版主帮忙。 虽然问题没能解决。 不过通过其他路径已经解决。使用ADODB.Stream 方式。 已成功从SQL Server中成功获取图片显示在excel中了。 再次感谢版主问津。

[舉杯邀明月]

引用 6 楼 yydpj 的回复:

谢谢版主帮忙。 虽然问题没能解决。 不过通过其他路径已经解决。使用ADODB.Stream 方式。 已成功从SQL Server中成功获取图片显示在excel中了。 再次感谢版主问津。

版主？？？