Topic: Reading and writing to Access 2007 (accdb file)

[ronjonp]

I generally don't ask for handouts...but today I am  . Does anyone have some example code (preferably vbs) to open a database, read a cell out of a specific column, and attach an image to another cell (the image name corresponds to the first cell read)?

This looks like the direction I need to go but I'm generally pretty lost  :ugly: outside the lisp language.

http://msdn.microsoft.com/en-us/library/bb257442.aspx

Any help would be appreciated.

*Attached example...need to read data from Structure ID column and attach a photo to the last column with the paperclip icon.

Thanks,

Ron

[deegeecees]

You can pick this apart if'n ya want. I use DAO for linking to the DB.

Code: [Select]

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

[ronjonp]

Thanks...I'll take a looksee.