请参(此处亦针对文本转化为表格进行处理) '* +++++++++++++++++++++++++++++
'* Created By I Love You_Word!@ExcelHome 2005-5-15 6:05:03
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* -----------------------------
Sub ExampleFour()
Dim CNN As New ADODB.Connection, i As Integer
Dim RST1 As New ADODB.Recordset, RST2 As New ADODB.Recordset
Dim Stpath As String, strSQL1 As String, strSQL2 As String
Dim MyString As String, MyBag As Long, Row1String As String
' On Error Resume Next
Stpath = "C:\WINNT\system32\ias\ias.mdb" '数据库路径
'打开指定数据库
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
'定义一个在表Objects中条件为Identity=13的Parent的值
strSQL1 = "SELECT Parent FROM Objects WHERE Identity=13"
'读取数据库
RST1.Open strSQL1, CNN, adOpenKeyset, adLockOptimistic, adCmdText
With RST1
Do While Not .EOF
'取得该值并赋于另一个新的查询中
MyBag = .Fields("Parent").Value
'定义一个在表Properties中条件为Bag=上一查询中的值的所有数据
strSQL2 = "SELECT * FROM Properties WHERE Bag=" & MyBag
RST2.Open strSQL2, CNN, adOpenKeyset, adLockOptimistic, adCmdText
With RST2
'注意,示列中的表的第一列为BAG,因已参与查询,注意I的循环次数
For i = 1 To .Fields.Count - 1
Row1String = Row1String & .Fields(i).Name & "?"
Next
'加上首列字段名,并去除原有的最后一个"?"再加一个段落标记
Row1String = "Bag?" & Mid(Row1String, 1, Len(Row1String) - 1) & Chr(13)
Do While Not .EOF
'将该数据累加
MyString = MyString & .Fields("Bag") & "?" & .Fields("Name") & "?" & .Fields("Type") & "?" & .Fields("StrVal") & Chr(13)
.MoveNext
Loop
End With
.MoveNext '向下移动记录指针
Loop
RST2.Close
.Close '关闭数据表
End With
Set RST1 = Nothing '释放对象
Set RST2 = Nothing '释放对象
Set CNN = Nothing '释放对象
'将"表格"首行合并到字符串中
MyString = Row1String & MyString
'插入字符串
Selection.InsertAfter MyString
'以?号为分隔符将文本转换为表格
Selection.ConvertToTable Separator:="?"
End Sub
'----------------------
[此贴子已经被作者于2005-5-15 6:06:21编辑过] |