You can pick this apart if'n ya want. I use DAO for linking to the DB.
Option Explicit
Public Tatts As Variant
Public ssnew_is As Object
Const DATABASE_DIR = "q:\std\drafting_db\"
Dim db As DAO.Database
Sub CaddReq()
Dim Projdia As String
Dim Caddr As String
Dim Filenm As String
Dim EntGrp(0) As Integer
Dim EntPrp(0) As Variant
Dim BlkObj As Object
Dim Pt1(0) As Double
Dim Pt2(0) As Double
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "db4_block" Then
objSelSet.Delete
Exit For
End If
Next
Call str_test
Set ssnew_is = ThisDrawing.SelectionSets.Add("db4_block")
EntGrp(0) = 2
EntPrp(0) = "drafting_db_block"
ssnew_is.Select acSelectionSetAll, Pt1, Pt2, EntGrp, EntPrp
If ssnew_is.Count >= 1 Then
Call cadreq_str
Tatts = ssnew_is.Item(0).GetAttributes
Filenm = (LTrim(Tatts(2).TextString))
Set db = DAO.OpenDatabase(DATABASE_DIR & "drafting_db_oldver.mdb", False, False)
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset( _
"SELECT * FROM CaddReqTrack WHERE File_Path = '" _
& D_path & "' AND FileName = '" & Filenm & "' AND Cadd_Req = '" & cad_req & "'")
If (rs.RecordCount > 0) Then
rs.Edit
rs.Fields("Drawing_Name") = (LTrim(Tatts(3).TextString))
rs.Fields("Station") = (LTrim(Tatts(4).TextString))
rs.Fields("Location") = (LTrim(Tatts(5).TextString))
rs.Fields("Description") = (LTrim(Tatts(6).TextString))
rs.Fields("Dwg_Scale") = (LTrim(Tatts(7).TextString))
rs.Fields("Rev_CE") = (LTrim(Tatts(8).TextString))
rs.Fields("Date_CE") = (LTrim(Tatts(9).TextString))
rs.Fields("Rev_Desc_CE") = (LTrim(Tatts(10).TextString))
rs.Fields("Drawn_By_CE") = (LTrim(Tatts(11).TextString))
rs.Fields("Eng_By_CE") = (LTrim(Tatts(12).TextString))
rs.Fields("Rev_GE") = (LTrim(Tatts(13).TextString))
rs.Fields("Date_GE") = (LTrim(Tatts(14).TextString))
rs.Fields("Rev_Desc_GE") = (LTrim(Tatts(15).TextString))
rs.Fields("Drawn_By_GE") = (LTrim(Tatts(16).TextString))
rs.Fields("Eng_By_GE") = (LTrim(Tatts(17).TextString))
rs.Fields("D_Code") = (LTrim(Tatts(18).TextString))
rs.Fields("S_Code") = (LTrim(Tatts(19).TextString))
rs.Update
Else
rs.AddNew
rs.Fields("Cadd_Req") = cad_req
rs.Fields("Filename") = (LTrim(Tatts(2).TextString))
rs.Fields("Drawing_Name") = (LTrim(Tatts(3).TextString))
rs.Fields("Station") = (LTrim(Tatts(4).TextString))
rs.Fields("Location") = (LTrim(Tatts(5).TextString))
rs.Fields("Description") = (LTrim(Tatts(6).TextString))
rs.Fields("Dwg_Scale") = (LTrim(Tatts(7).TextString))
rs.Fields("Rev_CE") = (LTrim(Tatts(8).TextString))
rs.Fields("Date_CE") = (LTrim(Tatts(9).TextString))
rs.Fields("Rev_Desc_CE") = (LTrim(Tatts(10).TextString))
rs.Fields("Drawn_By_CE") = (LTrim(Tatts(11).TextString))
rs.Fields("Eng_By_CE") = (LTrim(Tatts(12).TextString))
rs.Fields("Rev_GE") = (LTrim(Tatts(13).TextString))
rs.Fields("Date_GE") = (LTrim(Tatts(14).TextString))
rs.Fields("Rev_Desc_GE") = (LTrim(Tatts(15).TextString))
rs.Fields("Drawn_By_GE") = (LTrim(Tatts(16).TextString))
rs.Fields("Eng_By_GE") = (LTrim(Tatts(17).TextString))
rs.Fields("D_Code") = (LTrim(Tatts(18).TextString))
rs.Fields("S_Code") = (LTrim(Tatts(19).TextString))
rs.Fields("File_Path") = D_path
rs.Update
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
ThisDrawing.PurgeAll
End If
End Sub