[AccessD] 2 Questions concerning lists of fields and indexes

Heenan, Lambert Lambert.Heenan at chartisinsurance.com
Thu Oct 18 12:54:08 CDT 2012


Sorry about that folks, I had just crudely snipped some code out of a procedure. curIdx should indeed be dimmed as 

Dim curIdx As Index

Here is the whole procedure, which has some code in there for saving the info to tables for a table documenter tool I adapted from an old Access magazine years ago.

'---Begin DAO Code--------
Function DocumentTables(Optional sDbName As Variant)
Dim db As Database
Dim DbToDoc As Database
Dim rstTables As Recordset, rstTblDetail As Recordset
Dim curTbl As TableDef
Dim curFld As Field, curIdxFld As Field
Dim curIdx As Index
Dim cntTbls As Integer, cntFlds As Integer, cntKey As Integer
Dim cntIdx As Integer
Dim myTableName As String

Dim tempLastF As String

Const NO_DESC_FOUND = 3270

On Error GoTo DocumentTables_err

Set db = DBEngine(0)(0)
'Set db = CurrentDb
If IsMissing(sDbName) Then
    Set DbToDoc = db
Else
    Set DbToDoc = OpenDatabase(sDbName)
End If
ClearLastResultSet
'** Open the destination tables
Set rstTables = db.OpenRecordset("USysTables")
Set rstTblDetail = db.OpenRecordset("USysTableDetails")

'** Empty the destination tables
If rstTables.RecordCount <> 0 Then
    MyStatusText "Please wait..."
    Do While Not rstTables.EOF
        MyStatusText "Removing : " & rstTables.Fields("TableName")
        rstTables.Delete
        rstTables.MoveNext
    Loop
End If
MyStatusText ""
If rstTblDetail.RecordCount <> 0 Then
    Do While Not rstTblDetail.EOF
        MyStatusText "Removing : " & rstTblDetail("TableName")
        rstTblDetail.Delete
        rstTblDetail.MoveNext
    Loop
End If

'** Loop though all the tables in the database
For cntTbls = 0 To DbToDoc.TableDefs.Count - 1
    Set curTbl = DbToDoc.TableDefs(cntTbls)
    
    myTableName = curTbl.Name
    MyStatusText "Checking " & myTableName
    '** if the table is an MS system object ignore it
    If left(curTbl.Name, 4) <> "MSys" Then
        rstTables.AddNew  '** Add a new record
        rstTables("TableName") = curTbl.Name
        rstTables("DateCreated") = curTbl.DateCreated
        rstTables("DateUpdated") = curTbl.LastUpdated
        If curTbl.Connect <> "" Then
            rstTables("Description") = curTbl.Properties("Description")
            rstTables("Connect") = curTbl.Connect
        Else
            rstTables("Description") = curTbl.Properties("Description")
        End If
        rstTables.Update '** Save the record
        '** Loop though all the fields in the current table
        For cntFlds = 0 To curTbl.Fields.Count - 1
            'If Left(curFld.Name, 4) = "bCur" Then Stop
            Set curFld = curTbl.Fields(cntFlds)
            
            MyStatusText "Checking " & myTableName & " : field-" & curFld.Name
            rstTblDetail.AddNew '* add a record
            rstTblDetail("TableName") = curTbl.Name
            rstTblDetail("FieldName") = curFld.Name
            rstTblDetail("DataType") = GetFieldDataType(curFld)
            rstTblDetail("Size") = curFld.Size
            rstTblDetail("OrdinalPosition") = curFld.OrdinalPosition
            'rstTblDetail("Description") = curFld.Properties("Description")
            Dim oProp As Property
            For Each oProp In curFld.Properties
                If oProp.Name = "InputMask" Then
                    rstTblDetail("InputMask") = oProp.Value
                End If
            Next oProp
            
            '** Loop though all the indexes in the current table
            For cntKey = 0 To curTbl.Indexes.Count - 1
                Set curIdx = curTbl.Indexes(cntKey)
                '** Loop though all the fields in the current index
                For cntIdx = 0 To curIdx.Fields.Count - 1
                    Set curIdxFld = curIdx.Fields(cntIdx)
                    '* is the current field part of the primary key?
                    If (curFld.Name = curIdxFld.Name) And (curIdx.Primary = True) Then
                        rstTblDetail("PrimaryKey") = True
                    End If
                Next cntIdx ' move to next field in the current index
            Next cntKey ' move to next index in current table
            rstTblDetail.Update
        Next cntFlds
    End If
Next cntTbls
    
DocumentTable_Leave:
    MyStatusText ""
    Exit Function
    
DocumentTables_err:
    ' * If a table's description is blank, ignore the rror
    If Err = NO_DESC_FOUND Then
        Resume Next
    End If
    MsgBox "In DocumentTable. Error " & Err & " is: " & Error
    
    Resume DocumentTable_Leave
End Function
'----End Code ------- 

Lambert

-----Original Message-----
From: accessd-bounces at databaseadvisors.com [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Charlotte Foust
Sent: Thursday, October 18, 2012 1:08 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] 2 Questions concerning lists of fields and indexes

That's your problem, Arthur.  You're using  curIdx in the code but it isn't specifically dimmed.

Charlotte

On Thu, Oct 18, 2012 at 9:52 AM, Arthur Fuller <fuller.artful at gmail.com>wrote:

> Lambert,
>
> You said you copied this from an old app. So I can't figure out why it 
> won't compile in Access 2007. Perhaps it's because I always preface my 
> modules with Option Database and Option Explicit?
>
> <vba>
> ' Code from an old App...
> ' Indexes
> Dim cntKey  as Integer
> Dim curIdxFld As Field
> Dim cntIdx As Integer
> Dim curFld As Field
>
> For cntKey = 0 To Td.Indexes.Count - 1
>     Set curIdx = Td.Indexes(cntKey)
>     '** Loop though all the fields in the current index
>     For cntIdx = 0 To curIdx.Fields.Count - 1
>         Set curIdxFld = curIdx.Fields(cntIdx)
>         '* is the current field part of the primary key?
>         If (curFld.Name = curIdxFld.Name) And (curIdx.Primary = True) Then
>             ' log your primary key setting here
>         End If
>     Next cntIdx ' move to next field in the current index Next cntKey 
> ' move to next index in current table </vba>
> --
> Arthur
> Cell: 647.710.1314
>
> Memory is that part of the brain that, umm, I forget, but it does 
> something useful, I think.
> -- Arthur Fuller
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list