将pdf文件嵌入access数据库中，请问如何在程序中打开，分不够可以加

Question

将pdf文件嵌入access数据库中，请问如何在程序中打开？
谢谢先！

Answer 1

Option ExplicitPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim cn As New ADODB.Connection, rs   As New ADODB.Recordset'保存
Private Sub Command1_Click()
    Dim bteContent() As Byte
    
    Open "C:\aa.pdf" For Binary Access Read As #1
    bteContent = InputB(LOF(1), #1)
    Close #1
    
    If rs.State = adStateOpen Then rs.Close
    rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic
    rs.AddNew
    rs!Name = "张三"
    rs!AGE = 22
    rs!SEX = "男"
    rs.Fields("PDF").AppendChunk bteContent
    rs.Update
    
    Erase bteContent
End Sub'打开
Private Sub Command2_Click()
    Dim bteContent() As Byte
    If rs.State = adStateOpen Then rs.Close
    rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly
    bteContent = rs.Fields("PDF").GetChunk(rs.Fields("PDF").ActualSize)    Open "C:\aa.pdf" For Binary Access Write As #1
    Put #1, , bteContent
    Close #1
    ShellExecute Me.hwnd, "open", "C:\aa.pdf", vbNullString, vbNullString, 1
End SubPrivate Sub Form_Load()
On Error GoTo Errhandle
    cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#"
    cn.Open
    
    Exit Sub
Errhandle:
    MsgBox Err.Description, vbExclamation
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Answer 2

'*************************************************************************
'**
'** 使用 ADODB.Stream 保存/读取文件到数据库
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'**
'** ----- 数据库连接字符串模板 ---------------------------------------
'** ACCESS数据库
'** iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
'**     ";Data Source=数据库名"
'**
'** SQL数据库
'** iConcStr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
'**     "User ID=用户名;Password=密码;Initial Catalog=数据库名;Data Source=SQL服务器名"
'**'保存文件到数据库中
Sub s_SaveFile()
    Dim iStm As ADODB.Stream
    Dim iRe As ADODB.Recordset
    Dim iConcStr As String
    
    '数据库连接字符串
    iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
        ";Data Source=F:\csdn_vb\database\保存图片\img.mdb"
    Dim iConc As ADODB.Connection
    Set iConc = New ADODB.Connection
    
    iConc.Open iConcStr
    '读取文件到内容
    Set iStm = New ADODB.Stream
    With iStm
        .Type = adTypeBinary    '二进制模式
        .Open
        .LoadFromFile App.Path + "\com.doc"
    End With
    
    '打开保存文件的表
    Set iRe = New ADODB.Recordset
    With iRe
        .Open "select * from img", iConc, 1, 3
        .AddNew         '新增一条记录
        .Fields("photo") = iStm.Read
        .Update
    End With
    
    '完成后关闭对象
    iRe.Close
    iStm.Close
End SubSub s_ReadFile()
    Dim iStm As ADODB.Stream
    Dim iRe As ADODB.Recordset
    Dim iConc As String
    
    '数据库连接字符串
    iConc = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
        ";Data Source=F:\csdn_vb\database\保存图片\img.mdb"
    
    '打开表
    Set iRe = New ADODB.Recordset
    iRe.Open "img", iConc, adOpenKeyset, adLockReadOnly
    iRe.Filter = "id=3"   '比如单击datagrid后找到id=3的纪录
    
    '保存到文件
    Set iStm = New ADODB.Stream
    With iStm
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write iRe("photo")
        .SaveToFile "c:\com.doc"
    End With
    '这里使用了ole控件来显示doc文档
        OLE1.SourceDoc = "c:\\com.doc"
        OLE1.Action = 1    'use the old action method
        OLE1.SizeMode = vbOLESizeAuttoSize    '调节对象大小使其正好充满OLE容器控件    'Picture1.Picture = LoadPicture("c:\tesd.bmp")
    
    '关闭对象
    iRe.Close
    iStm.Close
End SubPrivate Sub Command1_Click()
Call s_ReadFile
End SubPrivate Sub Command2_Click()
Call s_SaveFile
End Sub