Access and AutoCAD

Public Function MY1()
    Dim p As Variant
    p = ThisDrawing.Utility.GetPoint(, "Start point:")
    Dim MyTable As AcadTable
    Set MyTable = ThisDrawing.ModelSpace.AddTable(p, 5, 5, 10, 30)
    Set db = OpenDatabase("d:\1.mdb", 0, False, key)
    Set rs = db.OpenRecordset("SELECT * FROM T1")
    i = 1
    While ((Not rs.EOF) And (i <= 4))
            MyTable.SetText i, 0, rs.Fields("Nazv").Value
            MyTable.SetText i, 1, rs.Fields("Nomer").Value
            rs.MoveNext
            i = i + 1
    Wend
End Function

Option Explicit
' References to:
' Microsoft ActiveX Data Object 2.X Library
' Microsoft Access X.X Object Library
Sub WriteAttributes()
' Variables for AutoCAD Objects
Dim oSset As AcadSelectionSet
Dim oEnt  As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAttr As AcadAttributeReference
Dim ftype(1) As Integer
Dim fdata(1) As Variant
Dim dxfCode, dxfValue
Dim attVar() As AcadAttributeReference
Dim i As Integer
' Variables for ADO Objects
Dim conn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
' Connect to the database
Dim tblName As String
tblName = "Blocks" '<-- change table name here
  'SQL string for adding recorset.
  strSQL = "INSERT INTO [" & tblName & "]"
  With conn
    .CursorLocation = adUseServer
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Data Source").Value = "C:\VBA\ACCESS\MyBlocks.mdb" ' <-- change database name here
    .Open
  End With
  With rst
    .LockType = adLockPessimistic
    .ActiveConnection = conn
    .CursorType = adOpenKeyset
    .CursorLocation = adUseServer
    .Source = strSQL
  End With
If Err <> 0 Then
MsgBox "Could not open " & tblName & ". Make sure " & _
"it has been configured in the DbConnect Manager."
Exit Sub
End If
' Open the Blocks recordset
rst.Open tblName, conn, adOpenDynamic, adLockOptimistic
If Err <> 0 Then
MsgBox "Could not open spaces recordset"
Exit Sub
End If
' Make sure the Recordset supports AddNew
If Not rst.Supports(adAddNew) Then
MsgBox "Cannot add records to the recordset."
Exit Sub
End If
' Get the selection set of all blocks in the current drawing
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("$Blocks$")
          End With
ftype(0) = 0: ftype(1) = 2
fdata(0) = "INSERT"
fdata(1) = InputBox(vbCr & "Enter the block name: ", "Block Name", "MyBlock")
dxfCode = ftype: dxfValue = fdata
oSset.Clear ' debug only
oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
'MsgBox oSset.Count 'debug only
If oSset.Count > 0 Then
' Switch to the last record
rst.MoveLast
' Loop through the selection and add the block data to the database
For Each oEnt In oSset
Set oBlkRef = oEnt
attVar = oBlkRef.GetAttributes
' Add a new blank record
rst.AddNew
' Set the field values
rst!BlockName = oBlkRef.EffectiveName
rst!TAG1 = attVar(0).TextString
rst!TAG2 = attVar(1).TextString
rst!TAG3 = attVar(2).TextString
rst!TAG4 = attVar(3).TextString
' Commit the changes
rst.Update
rst.MoveNext
Next
End If
' Close the recordset and the database connection
rst.Close
conn.Close
' Clean up
Set rst = Nothing
Set conn = Nothing
End Sub