谁能帮帮我？向VB中的ACCESS数据库添加*.bmp图片。

Question

调用通用对话框
2将aeccess的字段属性改用OLE

Answer 1

存:
Public Sub save_picture()
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
  Dim bit() As Byte
  dim varPath as string '图片的路径    cnn.open "连接数据库的字符串"
    sSql = "SELECT * FROM 表 WHERE 关键字='" & 关键值 & "'"
                      '选出要修改图片记录的记录,不存在就增加
    rst.Open sSql, cnn, adOpenKeyset, adLockOptimistic
    
    If Not (rst.EOF And rst.BOF) Then    
       If VarPath = "" Then
        '    然后将字节数组的内容写入数据库即可
            rst.Fields("图片") = ""
            rst.UPDATE
       Else
            Open VarPath For Binary As #1
            ReDim bit(LOF(1)) As Byte
            Get 1, 1, bit
            Close 1
         '    然后将字节数组的内容写入数据库即可
            rst.Fields("图片").AppendChunk bit
            rst.Fields("姓名") = "姓名"
            rst.UPDATE
       End If
    End If
end sub 取：
Public Sub show_picture()
Dim REC As Recordset
Dim sSql As String
Dim I As Integer
Set REC = New Recordset
Dim bit1() As Byte
Dim sa As String
sSql = "SELECT * FROM 表 WHERE 关键字 ='" & 关键值 & "'"
   REC.Open sSql, Conn, adOpenStatic, adLockOptimistic, adCmdText
     If REC.EOF Or REC.BOF Then
        Exit Sub
     Else
            Picture1.Picture = Nothing
            If REC("图片").ActualSize > 0 Then
                bit1 = REC.Fields("图片").GetChunk(REC("图片").ActualSize)
                '然后将字节数组的内容拼装成文件即可
                Open "c:\1.bmp" For Binary As #1
              
                Put 1, 1, bit1
                Close 1
                Picture1.Picture = LoadPicture("c:\1.bmp")  
                kill ("c:\1.bmp")              End If
     End If
    rec.close
    Set REC = Nothing
Exit Sub
Err:
   MsgBox "读取图片出错!", OKOnly, "系统提示"
End Sub

Answer 2

主要是这几句
'先打开一张图片,再将图片的二进制数据放入一数组
Open Mypicture For Binary As #1
ReDim bit(LOF(1)) As Byte
Get 1, 1, bit
'最后将概数组的值用AppendChunk方法添加到picture字段中.
'AppendChunk方法的具体用法见msdn.
rst1.Fields("Picture").AppendChunk bit

Answer 3

存文件到数据库Public Function AddFile() As Boolean    'Return boolean to decide whether refresh files list    Dim strBin As String * 3000    Dim btyGet() As Byte    Dim lngBlockIndex As Long    Dim lngBlocks As Long    Dim lngLastBlock As Long    Dim lngPosition As Long    Dim lngFileLenth As Long    Dim lngIndex As Long        With frmBinary.CommonDialog1        '.InitDir = App.Path        .Filter = "All image files|*.bmp;*.ico;*.jpg;*.gif|Bitmap files|*.bmp|Icon files|*.ico|All files|*.*"        .FileName = ""        On Error GoTo ErrorHandle        .ShowOpen        On Error GoTo 0        If .FileName <> "" Then            Open .FileName For Binary As #1            lngFileLenth = LOF(1)                        lngPosition = 0                        'Get block count for loop            lngBlocks = lngFileLenth \ BlockSize                        'Get lngth of last block for the last read            lngLastBlock = lngFileLenth Mod BlockSize                        rsBinary.AddNew            rsBinary.Fields("typecode") = TypeCode                        For lngBlockIndex = 1 To lngBlocks                ReDim btyGet(BlockSize)                Get #1, , btyGet()                rsBinary.Fields("content").AppendChunk btyGet()                lngPosition = lngPosition + BlockSize            Next            If lngLastBlock > 0 Then                ReDim btyGet(lngLastBlock)                Get #1, , btyGet()                rsBinary.Fields("content").AppendChunk btyGet()            End If                        rsBinary.Update            Close #1                        AddFile = True            MsgBox "Save finished", vbInformation        Else            AddFile = False        End If    End With    Exit FunctionErrorHandle:    AddFile = FalseEnd Function从数据库取文件出来Public Sub SaveFile(ByVal FileID As Long)    Dim lngBlockCount As Long    Dim lngLastBlock As Long    Dim lngI As Long    Dim btyBlock() As Byte    Dim lngResult As Long        If rsBinary.EOF And rsBinary.BOF Then Exit Sub    rsBinary.MoveFirst    rsBinary.Find " id=" & FileID    If Not rsBinary.EOF Then        With frmBinary.CommonDialog1            .FileName ="TempSave"            '.InitDir = App.Path                        'If user cancel save the goto handle            On Error GoTo ErrorHandle            .ShowSave            If .FileName <> "" Then                lngBlockCount = rsBinary.Fields("content").ActualSize \ BlockSize                lngLastBlock = rsBinary.Fields("content").ActualSize Mod BlockSize                                If Dir(.FileName) <> "" Then                    If MsgBox("File " & .FileName & " is exist,overwrite?", vbYesNo + vbQuestion) = vbYes Then                        Kill .FileName                    Else                        Exit Sub                    End If                Else                End If                                    Open .FileName For Binary As #1                                ReDim btyBinary(BlockSize)                                For lngI = 1 To lngBlockCount                    btyBlock() = rsBinary.Fields("content").GetChunk(BlockSize)                    Put #1, , btyBlock                Next                                If lngLastBlock <> 0 Then                    ReDim btyBlock(lngLastBlock)                    btyBlock() = rsBinary.Fields("content").GetChunk(lngLastBlock)                    Put #1, , btyBlock                End If                                Close #1                MsgBox .FileName & " is saved", vbInformation            Else            End If        End With    End If        Exit SubErrorHandle:    End Sub