|
|
数据库中有一个字段是OLE，我想把word中的一部分内容（程序中MyRange部分）存入其中，请问如何实现？
RjNAC5UC.rar
(10.08 KB, 下载次数: 7)
Sub dblink()
Dim Stpath As String, myt() As Table, i As Integer, k As Integer, tc As Integer
Dim obj As String, dt As Date, pub As String
Dim md As New ADODB.Connection, rs As New ADODB.Recordset
Stpath = "C:\Documents and Settings\Bluewater\桌面\test.mdb" '数据库位置
md.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
strSQL1 = "select * from test"
rs.Open strSQL1, md, adOpenKeyset, adLockOptimistic, adCmdText
tc = ActiveDocument.Tables.Count
ReDim Preserve myt(tc)
On Error Resume Next
For i = 1 To tc
If InStr(ActiveDocument.Tables(i).Cell(1, 2).Range, "News Clipping") <> 0 Then
k = k + 1
Set myt(k) = ActiveDocument.Tables(i)
End If
Next i
For i = 1 To k
With ActiveDocument
obj = .Range(myt(i).Cell(5, 3).Range.start, myt(i).Cell(5, 3).Range.End - 1)
pub = .Range(myt(i).Cell(2, 3).Range.start, myt(i).Cell(2, 3).Range.End - 1)
pub = Left(pub, InStr(pub, "/") - 1)
dt = .Range(myt(i).Cell(3, 3).Range.start, myt(i).Cell(3, 3).Range.End - 1)
If i <> k Then
Set MyRange = .Range(myt(i).Range.start, myt(i+1).Range.End - 1)
Else
Set MyRange = .Range(myt(i).Range.start, .Range.End)
End If
End With
With rs
.AddNew
.Fields("obj") = obj
.Fields("pub") = pub
.Fields("dt") = dt
.Update
End With
Next i
End Sub
注：上传附件中word文档的程序中要把Set MyRange = .Range(myt(i).Range.start, myt(i).Range.End - 1)改为Set MyRange = .Range(myt(i).Range.start, myt(i+1).Range.End - 1)。
[此贴子已经被作者于2006-4-27 18:02:25编辑过] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-4-27 17:59
发表于 2006-4-28 09:29
楼主