图片的读取（Access），得到答案就结贴，不够再加分

Question

象下面这样就行了
Private Sub Command3_Click()
Dim conn As New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\1.mdb;Persist Security Info=False"
conn.Execute "create table a (b longbinary)"
End SubPrivate Sub Command4_Click()
    Set b = New ADODB.Recordset
    Set c = New ADODB.Stream
        
        
        c.Mode = adModeReadWrite    c.Type = adTypeBinary
    c.Open
    c.LoadFromFile "c:\1.bmp"
    
    b.Open "select * from a", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\1.mdb;Persist Security Info=False", adOpenDynamic, adLockOptimistic
    b.AddNew
    
    b.Fields.Item(0).Value = c.Read()
    
    
    b.Update
    
    b.Close
    Set b = New ADODB.Recordset
    b.Open "select * from a", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\1.mdb;Persist Security Info=False", adOpenKeyset, adLockOptimistic
    MsgBox b.RecordCount
    
    b.MoveLast
    
    c.Write (b.Fields.Item(0).Value)
    
    c.SaveToFile "c:\aa.bmp", adSaveCreateOverWrite
    
    Picture1.Picture = LoadPicture("c:\aa.bmp")
End Sub

Answer 1

给你两个过程！如果成功就给分
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