我是转抄坛子中一位高手的内容,是谁我忘了(不好意思)：

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stm As ADODB.Stream

Private Sub SavePictureToDB(cn As ADODB.Connection)
'将BMP图片存入数据库
On Error GoTo EH
    Set stm = New ADODB.Stream
    rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
    CommonDialog1.ShowOpen
    Text1.Text = CommonDialog1.FileName
    
    With stm
         .Type = adTypeBinary
         .Open
         .LoadFromFile CommonDialog1.FileName
    End With
    With rs
         .AddNew
         .Fields("ImagePath") = Text1.Text
         .Fields("ImageValue") = stm.Read
         .Update
    End With
    rs.Close
    Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub


Private Sub LoadPictureFromDB(cn As ADODB.Connection)
'载数据库中读出BMP图片
On Error GoTo EH
    Dim strTemp As String
    Set stm = New ADODB.Stream
    strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
    rs.Open "select ImagePath,ImageValue  from tbl_image", cn, , , adCmdText
    With stm
        .Type = adTypeBinary
        .Open
        .Write rs("ImageValue")
        .SaveToFile strTemp, adSaveCreateOverWrite
        .Close
    End With
    Image1.Picture = LoadPicture(strTemp)
    Set stm = Nothing
    rs.Close
    Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub


image类型
用picture显示
'以下两个函数是从数据库中读出图片的核心程序

Public Function GetImage(Optional Filename As String) As Variant
On Error GoTo ProcErr

  Dim objRS As adodb.Recordset
  Dim strSQL As String
  Dim Chunk() As Byte
 
  Set objRS = New adodb.Recordset
  
  'strSQL = "select thumb from tblpictures where idpict='" & tblID(ThumbIndex) & "'"
  strSQL = "select thumb from tblpictures where idpict= " & thumb
  'strSQL = "select thumb from tblpictures where idpict='387'"
  'db.Execute strSQL
  objRS.Open strSQL, db, adOpenForwardOnly, adLockReadOnly
  
  If objRS.BOF And objRS.EOF Then
    GetImage = 0
    GoTo ProcExit
  ElseIf IsNull(objRS.Fields(0)) Then
    'ErrNumber = 1001
    'ErrDesc = "字段为空"
    GoTo ProcExit
  End If
  
  Chunk() = objRS.Fields(0).GetChunk(objRS.Fields(0).ActualSize)
  Set GetImage = Chunk2Image(Chunk(), Filename)

ProcExit:
  On Error Resume Next
  'objRS.Close
   ' Chunk() = objRS.Fields(0).GetChunk(0)
    Set GetImage = Chunk2Image(Chunk(), Filename)
 ' Set objRS = Nothing

  Exit Function

ProcErr:
  GetImage = 0
  Resume ProcExit
End Function


Private Function Chunk2Image(Chunk() As Byte, Optional Filename As String) As Variant
On Error GoTo ProcErr
Dim KeepFile As Boolean
Dim Datafile As Integer

    KeepFile = True
    If Trim(Filename) = "" Then
      Filename = "c:\tmpxxdb.fil"
      KeepFile = False
    End If

    Datafile = FreeFile
    Open Filename For Binary Access Write As Datafile
      Put Datafile, , Chunk()
    Close Datafile

ProcExit:
  Set Chunk2Image = LoadPicture(Filename)
  On Error Resume Next
'  If Not KeepFile Then Kill filename
  Exit Function

ProcErr:
  On Error Resume Next
  Kill Filename
  Chunk2Image = 0
End Function

http://expert.csdn.net/Expert/TopicView1.asp?id=1521284 101例子中有
我也写了一片:
http://www.csdn.net/develop/read_article.asp?id=14963

http://www.csdn.net/develop/read_article.asp?id=14963