各位老鳥﹕保存OLE 對象的問題﹗困惑小弟很久了﹐現在都還沒有解決﹐再求各位相助﹗﹗﹗

Question

各位老鳥:
      我在 VB6.0 當中用到OLE對象文件﹐文件類型為 ﹕"Word.Document.8"
      請問﹕我如何才能把這個OLE對象文件的數據保存到SQL 2000 的數據庫中去啊﹐
            且在數據庫中的字段要設置成什么類型啊﹗是不是要設為二進制啊!                                        望各位老鳥幫忙,不勝感謝﹗﹗﹗

Answer 1

且在數據庫中的字段要設置成什么類型啊﹗是不是要設為二進制啊!
是
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;258038'*************************************************************************
'**
'** 使用 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
    
        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

Answer 2

但是我現用的是sql 2000的數據﹐請問可否給個答案給小弟啊﹗謝謝...

Answer 3

不好意思﹐看錯了﹐有sql 的代碼﹗先謝了

Answer 4

Option Explicit'工程->引用->Microsoft ActiveX Data Objects 2.0 Library (后面为版本号)
Dim cn As New ADODB.Connection, rs   As New ADODB.RecordsetPrivate 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'保存
Private Sub Command1_Click()
    Dim bteContent() As Byte
    
    Open "C:\aa.doc" 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("DOC").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("DOC").GetChunk(rs.Fields("PHOTO").ActualSize)    Open "C:\aa.doc" For Binary Access Write As #1
    Put #1, , bteContent
    Close #1
    ShellExecute Me.hwnd, "open", "c:\aa.doc", 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 5

'** 数据库使用 ADODB.Stream 保存/读取Word文档的示例代码
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'** 引用 Microsoft Word 9.0 Objects Library
'** 保存Word文档的字段为word（Access数据库为OLE对象，SQL数据库为二进制数据类型）Option Explicit
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim StmWord As ADODB.Stream
    
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()Private Sub Form_Initialize()
    InitCommonControls
End Sub'调用WORD函数
Sub OpenWord(FileName As String)
    Dim WordTemps As New Word.Application
    WordTemps.Documents.Add FileName, False
    WordTemps.Visible = True
End Sub'窗体载入时连接数据库
Private Sub Form_Load()
    Set cn = New ADODB.Connection
    cn.Open "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
        "User ID=用户名;Password=密码;"& _
        "Initial Catalog=数据库名;Data Source=SQL服务器名"
End Sub'将Wowd文档保存到数据库
Private Sub cmdSave_Click()
    Set rs = New ADODB.Recordset
    rs.Open "select * from TableName", _
        cn, adOpenKeyset, adLockOptimistic
    Set StmWord = New ADODB.Stream
    With StmWord
        .Type = adTypeBinary
        .Open
        .LoadFromFile "F:\My Documents\test.doc"
    End With
    rs.AddNew
    rs.Fields(1).Value = StmWord.Read
    rs.Update
    StmWord.Close
    rs.Close
End Sub'读取数据库中的Word文档
Private Sub cmdRead_Click()
    Dim Sql As String
    Sql = "select * from TableName where id=3"
    Set rs = New ADODB.Recordset
    rs.Open Sql, cn, adOpenKeyset, adLockOptimistic
    Set StmWord = New ADODB.Stream
    With StmWord
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write rs!Word
        .SaveToFile App.Path & "\TempTest.doc"
        .Close
    End With
    Call OpenWord(App.Path & "\TempTest.doc")
    rs.Close
End Sub

Answer 6

不好意思，多了如下几行(无用)：
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()Private Sub Form_Initialize()
    InitCommonControls
End Sub