請教：ADP+SQL 如何存儲、顯示照片【已解決】

yhf

數(shù)據(jù)庫ADP+SQL:表中有一" image"類型的字段"照片"，請教在窗體顯示、添加、刪除照片的代碼，謝謝！
以前在網(wǎng)上找到過以下代碼，在MDB中沒問題，但在ADP中顯示“類型不匹配”：

Option Compare Database
Option Explicit

Public ImgPath As String
Public Function LoadBImage(ByVal NewForm As Form, _
                           ByVal NewID As String, _
                           ByVal NewIDValue As Variant, _
                           ByVal NewField As String, _
                           ByVal NewImage As Image)
'==============================================================================
'-函數(shù)名稱:     LoadBImage
'-功能描述:     以二進(jìn)制數(shù)據(jù)格式加載圖片,并保存于數(shù)據(jù)庫,一般為當(dāng)前數(shù)據(jù)庫,
'               若窗體引用記錄集為外部ACCESS數(shù)據(jù)庫,同樣適用,調(diào)用函數(shù)SaveImage
'-輸入?yún)��?shù)說明: 參數(shù)1: 必選 應(yīng)用顯示圖片的窗體,[對象變量]
'               參數(shù)2: 必選 窗體記錄集的主鍵名,[文本變量]
'               參數(shù)3: 必選 窗體某一記錄的主鍵值,一般為當(dāng)前記錄,[未定義變量]
'               參數(shù)4: 必選 圖片所在的字段名,[文本變量]
'               參數(shù)5: 必選 應(yīng)用顯示的圖片控件,[對象變量]
'-返回參數(shù)說明: 無
'-使用語法示例: Call LoadBImage(Me, "id", me.id, "圖片", me.image1)
'-參考:
'-使用注意:     NewForm, NewImage 為對象，使用時不能加引號
'               因為要使用文本流對象,請使用前引用 Microsoft ActiveX Objects 2.5以上
'-兼容性:       2000,XP,2003 compatible
'-作者:         duomu
'-更新日期：    2007-09-6
'===============================================================================
    Dim Result As Integer
    Dim FileName As String

    On Error GoTo HandleErr

    If Len(ImgPath) = 0 Then ImgPath = CurrentProject.Path

    With Application.FileDialog(1)
        .Title = "選擇照片"
        .Filters.Clear
       ' .Filters.Add "所有文件", "*.*"
        .Filters.Add "JPEG", "*.jpg"
       ' .Filters.Add "位圖文件", "*.bmp"
        .FilterIndex = 1
        .AllowMultiSelect = False
        .InitialFileName = "" ' ImgPath
        Result = .Show

        If Result = -1 Then
            FileName = Trim(.SelectedItems.Item(1))
            Call SaveBImage(FileName, NewForm, NewID, NewIDValue, NewField, NewImage)
        Else
            LoadBImage = 1
            Exit Function
        End If

        ImgPath = FileName
        NewImage.Picture = FileName
    End With
ExitHere:
    Exit Function

HandleErr:
    MsgBox err.Description
    Resume ExitHere
End Function

Public Function SaveBImage(ByVal FileName As String, _
                           ByVal NewForm As Form, _
                           ByVal NewID As String, _
                           ByVal NewIDValue As Variant, _
                           ByVal NewField As String, _
                           ByVal NewImage As Image)
'===============================================================================
'-函數(shù)名稱:     SaveBImage
'-功能描述:     以二進(jìn)制數(shù)據(jù)格式加載圖片,并保存于數(shù)據(jù)庫,一般為當(dāng)前數(shù)據(jù)庫,
'               若窗體引用記錄集為外部ACCESS數(shù)據(jù)庫,同樣適用,調(diào)用函數(shù)SaveImage
'-輸入?yún)��?shù)說明: 參數(shù)1: 必選 圖片路徑,[文本變量]
'               參數(shù)2: 必選 應(yīng)用顯示圖片的窗體,[對象變量]
'               參數(shù)3: 必選 窗體記錄集的主鍵名,[文本變量]
'               參數(shù)4: 必選 窗體某一記錄的主鍵值,一般為當(dāng)前記錄,[未定義變量]
'               參數(shù)5: 必選 圖片所在的字段名,[文本變量]
'               參數(shù)6: 必選 應(yīng)用顯示的圖片控件,[對象變量]
'-返回參數(shù)說明: 無
'-使用語法示例: 略
'-參考:         LoadBImage()過程
'-使用注意:     NewForm, NewImage 為對象，使用時不能加引號
'               因為要使用文本流對象,請使用前引用 Microsoft ActiveX Objects 2.5以上
'-兼容性:       2000,XP,2003 compatible
'-作者:         duomu
'-更新日期：    2007-09-6
'===============================================================================
    Dim ObjRst As DAO.Recordset
    Dim ObjStream As ADODB.Stream


    On Error GoTo HandleErr

    Set ObjRst = NewForm.Recordset
    Set ObjStream = New ADODB.Stream

    If Not IsNull(FileName) Then
        With ObjStream
            .Type = adTypeBinary
            .Open
            .LoadFromFile FileName
        End With
    End If

    If ObjRst.Fields(NewID).Type = dbText Then
        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"
    Else
        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue
    End If

    If Not ObjRst.NoMatch Then
        ObjRst.Edit
        ObjRst(NewField) = ObjStream.Read
        ObjRst.Update
    End If

    ObjStream.Close
    Set ObjStream = Nothing
ExitHere:
    Exit Function

HandleErr:
    MsgBox err.Description
    Resume ExitHere
End Function

Public Function DisplayBImage(ByVal NewForm As Form, _
                              ByVal NewID As String, _
                              ByVal NewIDValue As Variant, _
                              ByVal NewField As String, _
                              ByVal NewImage As Image)
'===============================================================================
'-函數(shù)名稱:     DisplayBImage
'-功能描述:     顯示以二進(jìn)制數(shù)據(jù)格式保存在數(shù)據(jù)庫內(nèi)的圖片
'-輸入?yún)��?shù)說明: 參數(shù)1: 必選 應(yīng)用顯示圖片的窗體,[對象變量]
'                參數(shù)2: 必選 窗體記錄集的主鍵名,[文本變量]
'                 參數(shù)3: 必選 窗體某一記錄的主鍵值,一般為當(dāng)前記錄,[未定義變量]
'                  參數(shù)4: 必選 圖片所在的字段名,[文本變量]
'                   參數(shù)5: 必選 應(yīng)用顯示的圖片控件,[對象變量]
'-返回參數(shù)說明: 無
'-使用語法示例: Call DisplayBImage(Me, "id", me.id, "圖片", me.image1)
'-參考:
'-使用注意:     NewForm, NewImage 為對象，使用時不能加引號
'               因為要使用文本流對象,請使用前引用 Microsoft ActiveX Objects 2.5以上
'-兼容性:       2000,XP,2003 compatible
'-作者:         duomu
'-更新日期：    2007-09-6
'===============================================================================

    Dim ObjRst As DAO.Recordset
    Dim ObjStream As ADODB.Stream

    On Error GoTo HandleErr

    Set ObjRst = NewForm.Recordset
    Set ObjStream = New ADODB.Stream

    If IsNull(NewIDValue) Then NewImage.Picture = "": Exit Function

    If ObjRst.Fields(NewID).Type = dbText Then
        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"
    Else
        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue
    End If

    If Not ObjRst.NoMatch Then
        If Len(ObjRst(NewField)) > 0 Then
            With ObjStream
                .Mode = adModeReadWrite
                .Type = adTypeBinary
                .Open
                .Write ObjRst(NewField)
                .SaveToFile CurrentProject.Path & "\image.jpg", adSaveCreateOverWrite
            End With
        Else
            NewImage.Picture = ""
            Exit Function
        End If
    End If

    NewImage.Picture = CurrentProject.Path & "\image.jpg"
    NewImage.SizeMode = acOLESizeZoom

    ObjStream.Close
    Kill CurrentProject.Path & "\image.jpg"
    Set ObjStream = Nothing

ExitHere:
    Exit Function

HandleErr:
    MsgBox err.Description
    Resume ExitHere
End Function

Public Function DeleteBImage(ByVal NewForm As Form, _
                             ByVal NewID As String, _
                             ByVal NewIDValue As Variant, _
                             ByVal NewField As String, _
                             ByVal NewImage As Image)
'===============================================================================
'-函數(shù)名稱:     LoadImage
'-功能描述:     刪除以二進(jìn)制數(shù)據(jù)格式保存在數(shù)據(jù)庫內(nèi)的圖片
'-輸入?yún)��?shù)說明: 參數(shù)1: 必選 應(yīng)用顯示圖片的窗體,[對象變量]
'               參數(shù)2: 必選 窗體記錄集的主鍵名,[文本變量]
'               參數(shù)3: 必選 窗體某一記錄的主鍵值,一般為當(dāng)前記錄,[未定義變量]
'               參數(shù)4: 必選 圖片所在的字段名,[文本變量]
'               參數(shù)5: 必選 應(yīng)用顯示的圖片控件,[對象變量]
'-返回參數(shù)說明: 無
'-使用語法示例: Call LoadImage(Me, "id", me.id, "圖片", me.image1)
'-參考:
'-使用注意:     NewForm, NewImage 為對象，使用時不能加引號
'               因為要使用文本流對象,請使用前引用 Microsoft ActiveX Objects 2.5以上
'-兼容性:       2000,XP,2003 compatible
'-作者:         duomu
'-更新日期：    2007-09-6
'===============================================================================
    Dim ObjRst As DAO.Recordset

    On Error GoTo HandleErr

    Set ObjRst = NewForm.Recordset

    If ObjRst.Fields(NewID).Type = dbText Then
        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"
    Else
        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue
    End If

    If Not ObjRst.NoMatch Then
        ObjRst.Edit
        ObjRst(NewField) = ""
        ObjRst.Update
    End If

    NewImage.Picture = ""

ExitHere:
    Exit Function

HandleErr:
    MsgBox err.Description
    Resume ExitHere
End Function

yhf

zhuyiwen 發(fā)表于 2012-9-4 06:39
SaveBImage / DisplayBImage / DeleteBImage 三函數(shù)中使用 Dim ObjRst As DAO.Recordset 來引用 窗體記錄集 ...

謝謝管理員指教！ 已按您的方法測試，但出錯“編譯錯誤:方法和數(shù)據(jù)成員未找到”。再請教！

zhuyiwen

SaveBImage / DisplayBImage / DeleteBImage 三函數(shù)中使用 Dim ObjRst As DAO.Recordset 來引用 窗體記錄集 Set ObjRst = NewForm.Recordset，這肯定會類型不正確，因為 ADP 窗體的記錄集只能是 ADO 記錄集，而不能是 DAO 記錄集。你改成：

1. 
   
2. Dim ObjRst As ADODB.Recordset
   

復(fù)制代碼

試試

zhuyiwen

友情提示：抄代碼沒有錯，但要正確理解代碼，才能真正地使用代碼，節(jié)省時間。

liangshu-fu

值得學(xué)習(xí)。

yhf

根據(jù)網(wǎng)絡(luò)資料自己搗鼓的：
Dim filename As String

Sub deleteImage()
On Error GoTo erro1:

    Dim rs As New ADODB.Recordset
    Dim Istm As ADODB.Stream
    rs.Open "儲存圖片的表名稱", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Set Istm = New ADODB.Stream

    rs("圖片") = ""
    rs.Update
    rs.Close
    Istm.Close
    Set rs = Nothing
    Set Istm = Nothing

erro1:
End Sub


Private Sub 刪除_Click()
deleteImage
Me.Image1.Picture = ""
End Sub

Sub SaveImage()
On Error GoTo erro1:

    Dim rs As New ADODB.Recordset
    Dim Istm As ADODB.Stream
    rs.Open "儲存圖片的表名稱", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Set Istm = New ADODB.Stream
    If Not IsNull(filename) Then
        With Istm
            .Type = adTypeBinary
            .Open
            .LoadFromFile filename
        End With
    End If

    rs("圖片") = Istm.Read
    rs.Update
    rs.Close
    Istm.Close
    Set rs = Nothing
    Set Istm = Nothing
erro1:
End Sub

Sub GetImgName()
On Error GoTo erro1:

    Dim Result As Integer
    With Application.FileDialog(1)
        .Title = "選擇照片"
        .Filters.Clear
        .Filters.Add "JPEGs", "*.jpg"
        .Filters.Add "位圖文件", "*.bmp"
        .FilterIndex = 1
        .AllowMultiSelect = False
        .InitialFileName = "" ' CurrentProject.Path
        Result = .Show
        filename = Trim(.SelectedItems.Item(1))
        Image1.Picture = filename
    End With
erro1:
End Sub

Private Sub Form_Open(Cancel As Integer)
If IsNull(Me.圖片) Then
   Me.Image1.Picture = ""
Else
   Me.Image1.PictureData = Me.圖片
End If
End Sub


Private Sub 更新_Click()
    'Me.Image1.Picture = ""
    GetImgName
    SaveImage
    Me.Refresh
End Sub

Private Sub 下載_Click()
    Dim strNewFile As String
    Dim stm As ADODB.Stream
   
    '下載時通過另存為文件對話框選擇另存為路徑名
    With Application.FileDialog(2) 'msoFileDialogSaveAs
        .InitialFileName = 6786786 & ".jpg"
        If .Show Then
            strNewFile = .SelectedItems(1)
            '將保存在數(shù)據(jù)庫中的二進(jìn)制文件保存到流對象，再通過流對象另存為文件
            Set stm = New ADODB.Stream
            stm.Mode = adModeReadWrite
            stm.Type = adTypeBinary
            stm.Open
            stm.Write Me.圖片
            '如果文件已存在，則先刪除已存在的文件，以達(dá)到替換目的
            If Dir(strNewFile) <> "" Then Kill strNewFile
            stm.SaveToFile strNewFile
            stm.Close
            MsgBox "下載完成。", vbInformation, "提示信息"
        End If
    End With
    Set stm = Nothing
End Sub


說明： “圖片”為 儲存圖片的表 內(nèi)儲存圖片的字段(image)
           image1 為 窗體上 圖像控件

            窗體命令按鈕：刪除、更新、下載