用Ado如何存取Access数据库里的OLE字段图片?代码如下:

Question

你好，这段代码我试了一下，可是
Put #1, , rs("photos")
'错误发生在这里“编译错误：不能GET和PUT一个对象引用变量或包含对象引用的用户定义类型”
请问这段代码你运行有问题吗，我现在也急需解决这个问题，谢谢你了

Answer 1

VB中有一个OLE控件框不知道是做什么用的，我昨天查MSDN好象是用来联接OLE字段的可是不知怎么用

Answer 2

我也正在解决这个问题，如果你先解决的话发给我[email protected],先谢谢了

Answer 3

代码如下，同时我还发了一个程序给你，请在邮箱查收
Dim cn As ADODB.Connection
Dim strm As ADODB.Stream
Dim rst As ADODB.Recordset
Private Sub Command1_Click()
'移动数据记录指针超出范围出错
  rst.MoveNext
End SubPrivate Sub Form_Load()
Set cn = New ADODB.Connection
Set strm = New ADODB.Stream
Set rst = New ADODB.Recordsetcn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & ".\data\xj.mdb"
strm.Mode = adModeReadWrite
strm.Type = adTypeBinary
strm.Open
'****************向数据库存入照片
strm.LoadFromFile App.Path & ".\icon\bb.jpg" '文件名不要打错
rst.Open "select * from xj2000ph", cn, adOpenKeyset, adLockOptimistic
rst.AddNew
rst.Fields.Item(0).Value = "12361" '数据库定义的第一个字段是主键所以必须赋值
rst.Fields.Item(1).Value = strm.Read '第二个字段是照片字段
rst.Update
rst.Close
'***************************从数据库读取图片
Set rst = New ADODB.Recordset
rst.Open "select * from xj2000ph ", cn
'**********************第一种方法
strm.Write (rst.Fields("照片").Value)
strm.SaveToFile App.Path & ".\aa.bmp", adSaveCreateOverWrite
Image1.Picture = LoadPicture(App.Path & ".\aa.bmp")
'**********************第二种方法
    Image1.DataField = rst!照片.Name
    Set Image1.DataSource = rst
      
'       rst.Close
'       Set rst = Nothing'*************将数据库图片字段绑定至image2
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & ".\data\xj.mdb"
Adodc1.RecordSource = "xj2000ph"
Adodc1.Refresh
Image2.DataField = Adodc1.Recordset.Fields("照片").Name
'**************************
End Sub

Answer 4

试试这个吧
Option Explicit
Dim conn As ADODB.Connection
Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1Private Sub Savepic()
  Open "c:\YOU.gif" For Binary Access Read As lngDataFile
  lngLengh = LOF(lngDataFile)
  If lngLengh = 0 Then Close lngDataFile: Exit Sub
  intChunks = lngLengh \ ChunkSize
  intFragment = lngLengh Mod ChunkSize
  
  'OpenData 打开数据库
  Dim i As Integer
  Dim rs As New ADODB.Recordset
  Dim strQ  As String
  
  If rs.State = adStateOpen Then rs.Close
  
  strQ = "Select * From [mydata]"
  rs.Open strQ, conn, adOpenStatic, adLockOptimistic
  
  On Error Resume Next
  
  rs.AddNew
  
  ReDim Chunk(intFragment)
  Get lngDataFile, , Chunk()
  rs.Fields("rs_photo1").AppendChunk Chunk()
  ReDim Chunk(ChunkSize)
  
  For i = 1 To intChunks
      Get lngDataFile, , Chunk()
      rs.Fields("rs_photo1").AppendChunk Chunk()
  Next i
  
  rs.Update
  rs.Close
  Close lngDataFile
  Call ShowPic
End SubPublic Sub ShowPic()
  'OpenData 打开数据库
  Dim i As Integer
  Dim rs As New ADODB.Recordset
  Dim strQ, filename As String
  If rs.State = adStateOpen Then rs.Close  strQ = "Select * From [mydata]"
  rs.Open strQ, conn, adOpenStatic, adLockOptimistic
  If rs.EOF <> True Then
      rs.MoveLast
  Else
      Exit Sub
  End If
  On Error Resume Next
  Open "pictemp" For Binary Access Write As lngDataFile
      lngLengh = rs.Fields("rs_photo1").ActualSize
      intChunks = lngLengh \ ChunkSize
      intFragment = lngLengh Mod ChunkSize
      ReDim Chunk(intFragment)
      Chunk() = rs.Fields("rs_photo1").GetChunk(intFragment)
      Put lngDataFile, , Chunk()
      For i = 1 To intChunks
         ReDim Buffer(ChunkSize)
         Chunk() = rs.Fields("rs_photo1").GetChunk(ChunkSize)
         Put lngDataFile, , Chunk()
      Next i
  Close lngDataFile
  filename = "pictemp"
  Picture1.Picture = LoadPicture(filename)
  Image1.Stretch = True
  Image1.Picture = Picture1.Picture
  Kill filename
End Sub