数据库中的二进制数据是word文档内容,我要把它读回到word中,该怎么办?
最好有示范程序,谢谢

解决方案 »

  1.   

    读取/写入二进制数据,可用ADO中GetChunk /AppendChunk方法实现!'BeginAppendChunkVB    'To integrate this code
        'replace the data source and initial catalog values
        'in the connection string
        
    Public Sub AppendChunkX()    'recordset and connection variables
       Dim Cnxn As ADODB.Connection
       Dim strCnxn As String
       Dim rstPubInfo As ADODB.Recordset
       Dim strSQLPubInfo As String
        'record variables
       Dim strPubID As String
       Dim strPRInfo As String
       Dim lngOffset As Long
       Dim lngLogoSize As Long
       Dim varLogo As Variant
       Dim varChunk As Variant
       Dim strMsg As String
       
       Const conChunkSize = 100   ' Open a connection
       Set Cnxn = New ADODB.Connection
       strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; "
       Cnxn.Open strCnxn
       
       ' Open the pub_info table with a cursor that allows updates
       Set rstPubInfo = New ADODB.Recordset
       strSQLPubInfo = "pub_info"
       rstPubInfo.Open strSQLPubInfo, Cnxn, adOpenKeyset, adLockOptimistic, adCmdTable
       
       ' Prompt for a logo to copy
       strMsg = "Available logos are : " & vbCr & vbCr
       Do While Not rstPubInfo.EOF
          strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
             Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _
             vbCr & vbCr
          rstPubInfo.MoveNext
       Loop
       
       strMsg = strMsg & "Enter the ID of a logo to copy:"
       strPubID = InputBox(strMsg)
       
       ' Copy the logo to a variable in chunks
       rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
       lngLogoSize = rstPubInfo!logo.ActualSize
       Do While lngOffset < lngLogoSize
          varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
          varLogo = varLogo & varChunk
          lngOffset = lngOffset + conChunkSize
       Loop
       
       ' Get data from the user
       strPubID = Trim(InputBox("Enter a new pub ID" & _
                                " [must be > 9899 & < 9999]:"))
       strPRInfo = Trim(InputBox("Enter descriptive text:"))   ' Add the new publisher to the publishers table to avoid
       ' getting an error due to foreign key constraint
       Cnxn.Execute "INSERT publishers(pub_id, pub_name) VALUES('" & _
                      strPubID & "','Your Test Publisher')"
       
       ' Add a new record, copying the logo in chunks
       rstPubInfo.AddNew
       rstPubInfo!pub_id = strPubID
       rstPubInfo!pr_info = strPRInfo   lngOffset = 0 ' Reset offset
       Do While lngOffset < lngLogoSize
          varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
             conChunkSize)
          rstPubInfo!logo.AppendChunk varChunk
          lngOffset = lngOffset + conChunkSize
       Loop
       rstPubInfo.Update
       
        ' Show the newly added data
       MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
          "Description: " & rstPubInfo!pr_info & vbCr & _
          "Logo size: " & rstPubInfo!logo.ActualSize   ' Delete new records because this is a demo
       rstPubInfo.Requery
       Cnxn.Execute "DELETE FROM pub_info " & _
          "WHERE pub_id = '" & strPubID & "'"   Cnxn.Execute "DELETE FROM publishers " & _
          "WHERE pub_id = '" & strPubID & "'"    ' clean up
       rstPubInfo.Close
       Cnxn.Close
       Set rstPubInfo = Nothing
       Set Cnxn = NothingEnd Sub
    'EndAppendChunkVB
      

  2.   

    将数据读出保存为临时word文件,再用word打开
      

  3.   

    '将任何文件从数据库中下载到本地: 
        Public Function LoadFile(ByVal col As ADODB.Field, ByVal FileName As String) As Boolean '获得binary数据 
        On Error GoTo myerr: 
         Dim arrBytes() As Byte 
         Dim FreeFileNumber As Integer 
         lngsize = col.ActualSize 
         arrBytes = col.GetChunk(lngsize) 
         FreeFileNumber = FreeFile 
         Open FileName For Binary Access Write As #FreeFileNumber 
         Put #FreeFileNumber, , arrBytes 
         Close #FreeFileNumber 
         LoadFile = True 
        myerr: 
         If Err.Number <> 0 Then 
         LoadFile = False 
         Err.Clear 
         End If 
        End Function 
         
        '将文件从本地上传到数据库中 
        Public Function UpLoadFile(ByVal FileName, ByVal col As ADODB.Field) As Boolean 
         On Error GoTo myerr: 
         Dim arrBytes() As Byte 
         Dim FreeFileNumber As Integer 
         FreeFileNumber = FreeFile 
         Open FileName For Binary As #FreeFileNumber 
         n = LOF(FreeFileNumber) 
         ReDim arrBytes(1 To n) As Byte 
         Get #FreeFileNumber, , arrBytes 
         Close #FreeFileNumber 
         col.AppendChunk (arrBytes) 
         UpLoadFile = True 
        myerr: 
         If Err.Number <> 0 Then 
         UpLoadFile = False 
         Err.Clear 
         End If 
        End Function