在搜索旧程序时,我发现了这个。它使用Excel文件作为数据库。原始程序循环通过选择集并搜索具有属性的特定块。然后将属性文本与Excel文件中的单元格进行比较。从那里,Excel中的其他信息被拉入并转储到AutoCAD中的表对象中,创建一种“动态”表。
- Dim x As Integer
- For x = 0 To UBound(objKeys)
- [color=red]GetLightInfo[/color] UCase(objKeys(x))
- objTable.InsertRows objTable.Rows, 0.59375, 1
- objTable.Update
- objTable.SetText objTable.Rows - 1, 0, objDict(objKeys(x))
- objTable.SetText objTable.Rows - 1, 1, UCase(objKeys(x))
- objTable.SetText objTable.Rows - 1, 2, strMfg
- objTable.SetText objTable.Rows - 1, 3, strDesc
- objTable.SetText objTable.Rows - 1, 4, strVolts
- objTable.SetText objTable.Rows - 1, 5, strLamps
- Next x
- Option Explicit
- Public cn As ADODB.Connection
- Public rsT As ADODB.Recordset
- Public rsC As ADODB.Recordset
- Public Sub [color=red]GetLightInfo[/color](strID As String)
- Dim strQuery As String
- Dim rstQuery As New ADODB.Recordset
-
- OpenExcelDatabase
-
- strQuery = "SELECT * FROM [SCHEDULE_DATABASE$]"
- rstQuery.Open strQuery, cn, adOpenKeyset, adLockReadOnly
- rstQuery.Filter = "TYPE = '" & strID & "'"
-
- Do While Not rstQuery.EOF
- Debug.Print rstQuery!Type
- strDesc = rstQuery!Description
- strMfg = rstQuery("MFR & SERIES")
- strVolts = rstQuery!VOLTS
- strLamps = rstQuery!LAMPS
- rstQuery.MoveNext
- Loop
- rstQuery.Close
-
- CloseExcelDatabase
- End Sub
- Private Sub OpenExcelDatabase()
- Dim intTblCnt As Integer, intTblFlds As Integer
- Dim strTbl As String
- Dim intColCnt As Integer, intColFlds As Integer
- Dim strCol As String
- Dim t As Integer, c As Integer, f As Integer
-
- Set cn = New ADODB.Connection
-
- With cn
- .Provider = "Microsoft.Jet.OLEDB.4.0"
- .ConnectionString = "Data Source=" & _
- "E:\Luminaire.xls;Extended Properties=Excel 8.0;"
- .CursorLocation = adUseClient
- .Open
- End With
- End Sub
- Private Sub CloseExcelDatabase()
- On Error Resume Next
- rsT.Close
- rsC.Close
- cn.Close
- End Sub
|