ADO如何存取Access 2000中的OLE字段(Word文档)

Question

可以用临时文件的方法来储存和读出文件 '储存 
Private Sub SavePic() 
Dim Conn As New ADODB.Connection 
Dim Rs0 As New ADODB.Recordset 
Dim Rs As New ADODB.Recordset 
Dim Maxnumber As Long 
Dim Sql As String 
Dim Connstr As String Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=joybig;Data Source=" & App.Path & "\pic.mdb;Persist Security Info=False" 
Conn.Open Connstr 
Rs.CursorLocation = adUseClient 
Rs.CursorType = adOpenKeyset 
Rs.LockType = adLockOptimistic 
DoEvents Dim picarray() As Byte 
Dim piclenth As Long 
Rs.Open "save", Conn, , , adCmdTable 
Rs.AddNew 
Rs("title") = Trim(Text3.Text) 
If Trim(Text1.Text) = "在此处输入备注信息" Then 
  Rs("note") = "" 
Else 
  Rs("note") = Trim(Text1.Text) 
End If 
piclenth = FileLen(App.Path & "\mydoc.doc") 
ReDim picarray(piclenth) 
Open App.Path & "\mydoc.doc" For Binary Access Read As #1 
Get #1, , picarray() 
Close #1 
Rs("pic").AppendChunk picarray 
Rs.Update 
Rs.Close 
Set Rs = Nothing 
Set Conn = Nothing 
End Sub '读出 
Private Sub ReadPic() 
Dim Conn As New ADODB.Connection 
Dim Rs0 As New ADODB.Recordset 
Dim Rs As New ADODB.Recordset 
Dim Maxnumber As Long 
Dim Sql As String 
Dim Connstr As String 
Dim picarray() As Byte 
Dim piclenth As Long Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=joybig;Data Source=" & App.Path & "\pic.mdb;Persist Security Info=False" 
Conn.Open Connstr 
Rs.CursorLocation = adUseClient 
Rs.CursorType = adOpenKeyset 
Rs.LockType = adLockOptimistic 
DoEvents Rs.Open "select * from [save]", Conn, adOpenKeyset, adLockOptimistic 
Text2.Text = Rs("title") 
Text4.Text = Rs("note") 
piclenth = Rs("pic").ActualSize ReDim picarray(piclenth) 
picarray = Rs("pic").GetChunk(piclenth) Open App.Path & "\doc1.doc" For Binary Access Write As #1 
Put #1, , picarray() 
Close #1 
Picture1.Picture = LoadPicture(App.Path & "\doc1.doc") 
Rs.Close 
Set Rs = Nothing 
Set Conn = Nothing 
End Sub 

Answer 1

哈哈~~马上给你，记得给分!access的ole字段类型MODUAL模块:
Public bit() As Byte
Public txtdbname As String
Public Enum CBoolean
  CFalse = 0
  ctrue = 1
End Enum
Declare Function CreateStreamOnHGlobal Lib "ole32" _
                              (ByVal hGlobal As Long, _
                              ByVal fDeleteOnRelease As CBoolean, _
                              ppstm As Any) As LongDeclare Function OleLoadPicture Lib "olepro32" _
                              (pStream As Any, _
                              ByVal lSize As Long, _
                              ByVal fRunmode As CBoolean, _
                              riid As GUID, _
                              ppvObj As Any) As LongPublic Type GUID
  dwData1 As Long
  wData2 As Integer
  wData3 As Integer
  abData4(7) As Byte
End TypeDeclare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Public Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const GMEM_MOVEABLE = &H2
Public Const S_OK = 0
Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Public Function PictureFromBits(abPic() As Byte) As IPicture
  Dim nLow As Long
  Dim cbMem  As Long
  Dim hMem  As Long
  Dim lpMem  As Long
  Dim IID_IPicture As GUID
  Dim istm As stdole.IUnknown
  Dim ipic As IPicture  On Error GoTo Out
  nLow = LBound(abPic)
  On Error GoTo 0
  cbMem = (UBound(abPic) - nLow) + 1
  hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
  If hMem Then
    lpMem = GlobalLock(hMem)
    If lpMem Then
      MoveMemory ByVal lpMem, abPic(nLow), cbMem
      Call GlobalUnlock(hMem)
      If (CreateStreamOnHGlobal(hMem, ctrue, istm) = S_OK) Then
        If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
          Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
          End If
      End If
    End If
End If
Out:
End Function窗体引用：
写到数据库：
  Open dbfilename For Binary As #1
            ReDim bit(LOF(1)) As Byte
            Get 1, 1, bit
            Close 1
            rs("word").AppendChunk bit
读数据库:
        dim bit1 as byte
        bit1 = rs("word").GetChunk(rs("word").ActualSize)
        '在此可以形成doc文件

Answer 2

word文档也好，其他文档也好，你都必须先把ole字段的二进制数据取出来，然后存成相应的文件，你这里就是*.doc。
在ado中，写和读ole字段使用AppendChunk方法和GetChunk方法。
流程是：
读doc文件－－>用appendchunk方法写到数据库中-->用getchunk方法读出来-->存成doc文件
具体的操作你可以参考ado文档。如果没有我下面给你发一个（很长）。

Answer 3

AppendChunk 和 GetChunk 方法范例
该范例使用 AppendChunk 和 GetChunk 方法用其他记录中的数据填写图像字段。Public Sub AppendChunkX()   Dim cnn1 As ADODB.Connection
   Dim rstPubInfo As ADODB.Recordset
   Dim strCnn As String
   Dim strPubID As String
   Dim strPRInfo As String
   Dim lngOffset As Long
   Dim lngLogoSize As Long
   Dim varLogo As Variant
   Dim varChunk As Variant
   
   Const conChunkSize = 100   ' 打开连接。
   Set cnn1 = New ADODB.Connection
      strCnn = "Provider=sqloledb;" & _
      "Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
   cnn1.Open strCnn
   
   ' 打开 pub_info 表。
   Set rstPubInfo = New ADODB.Recordset
   rstPubInfo.CursorType = adOpenKeyset
   rstPubInfo.LockType = adLockOptimistic
   rstPubInfo.Open "pub_info", cnn1, , , adCmdTable
   
   ' 提示复制徽标。
   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)
   
   ' 将徽标大块复制到变量中。
   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
   
   ' 从用户处得到数据。
   strPubID = Trim(InputBox("Enter a new pub ID:"))
   strPRInfo = Trim(InputBox("Enter descriptive text:"))
   
   ' 添加新记录，大块复制徽标。
   rstPubInfo.AddNew
   rstPubInfo!pub_id = strPubID
   rstPubInfo!pr_info = strPRInfo   lngOffset = 0 ' 重置位移。
   Do While lngOffset < lngLogoSize
      varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
         conChunkSize)
      rstPubInfo!logo.AppendChunk varChunk
      lngOffset = lngOffset + conChunkSize
   Loop
   rstPubInfo.Update
   
    ' 显示新添加的数据。
   MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
      "Description: " & rstPubInfo!pr_info & vbCr & _
      "Logo size: " & rstPubInfo!logo.ActualSize   ' 删除新记录，因为这只是演示。
   rstPubInfo.Requery
   cnn1.Execute "DELETE FROM pub_info " & _
      "WHERE pub_id = '" & strPubID & "'"   rstPubInfo.Close
   cnn1.Close   End Sub

Answer 4

大家好像说得都是图像的。。
我试一下。好像出来的是乱码，
我是要用一个OLE控件显示数据库中的一个OLE字段，双吉后可以编辑并保存到数据库，怎么做？
就像Access那样，你用向导建立一个Form，他的OLE字段就是可以直接编辑的。。
帮帮忙吧。