Master Table

gblack

Registered User.
Local time
Today, 07:53
Joined
Sep 18, 2002
Messages
632
What I am wondering is this: Has someone out there written any code that will loop through all the tables in an Access database and pull the table names AND field names into a recordset?

I know I could loop through the system table to get table names, but I am uncertain of how to pull the field names...

------------------------------------------------------------------------

I am trying to take a ridiculously long and very complex InfoPath/XML document (which has no real format/schema) and create from that, a normalized database in Access. In order to do this I need to ensure that every field in the XML document is accounted for in my Access Database.


My Master table would be pretty simple with only a couple fields: Table_Name, Field_Name
Data would look kind of like this:
Table1, Field1
Table1, Field2
Table2, Field1
Table2, Field2
Table2, Field3
Table3, Field1…


Of course after I get a table with all the tablenames and fields from the imported XML doc, then I can add my structure to it and basically have a master checklist, which is the goal here.

Any help would be greatly appreciated,
-Gary
 
Try typing in "Tabledefs" in vba and press F1, see how far you get using the help...
 
This looks very cool, but I am getting error because I don't have a table available.

Can you give me help on what the XMLNode table is supposed to look like structurally?

Thanks,
Gary
 
its says at the top

' recid - an autonumber
' nodeparent - the id of the parent node
' nodename - the name of this node
' nodechain - the concatenated path of nodes
' nodelevel - the lebel this node is in the hierarchy of nodes
' nodeorder - the order in which this node was encountered
' nodeleaf - a node with no children
' nodeValue - the value of this node

i think someone said i have recid here, but just id in the code.
 
Im getting an error when I try to run it... filref Variable not defined

Sub ParseMe(oNode As IXMLDOMNode, nodename As String, chainname As String, level As Long, parentref As Long)
Dim newnode As IXMLDOMNode
Dim leafnode As Boolean
Dim leaftext As String
Dim s As String
Dim nodecount As Long
Dim recid As Long

nodecount = 0
If oNode.hasChildNodes Then
For Each newnode In oNode.childNodes
'the child node is a leaf node, so dont go there, just output it
If newnode.nodename = "#text" Then
leafnode = True

'save the node in the gosub stuffnode
'this returns recid, as the autonumber of the new record
GoSub stuffnode
Else
'the trouble is we are stuffing the current node for each child node!
nodecount = nodecount + 1

If nodecount = 1 Then
leafnode = False

'this is not a leafnode, but save it if this is the first time we have seen this node
GoSub stuffnode
End If

Call ParseMe(newnode, newnode.nodename, chainname & "_" & newnode.nodename, level + 1, recid)
End If
Next
End If
Exit Sub



stuffnode:
recid = Nz(DLookup("id", "tblxmlnodes", "nodechain = " & fixup(chainname)), 0)
If recid > 0 Then
'we already saved this leaf
Return
End If

'else its a new one, so save it
nodesinspected = nodesinspected + 1
If leafnode Then
leaftext = newnode.XML
Else
leaftext = ""
End If

s = "insert into tblXMLNodes " & _
"(xmlref,nodeparent, nodename,nodechain,nodelevel,nodeorder,nodeleaf,nodevalue) select " & _
fileref & "," & parentref & "," & fixup(nodename) & "," & fixup(chainname) & "," & level & "," & nodesinspected & "," & leafnode & "," & fixup(leaftext) & ";"
' MsgBox (s)
CurrentDb.Execute s

'read back the recid of the stuffed node
recid = Nz(DLookup("id", "tblxmlnodes", "nodechain = " & fixup(chainname)), 0)
Return

End Sub
 
fileref is just the name of the file you are trying to parse
 
[fileref is just the name of the file you are trying to parse ]

What does that mean?

I get a compile error on that variable... what am I supposed to do with it in the code?
 
Allen,

I actually saw that code shortly after posting... but I am trying to get it to work and am running into errors... apparently there's an extra "Next" command in there that Access doesn't like...

Since I don't really need all the extra stuff about the datatypes, I could try to take that out. My only issue there is that there's a lot of loops and if-then's in there and I am not really sure how to take out the datatype stuff out without fragmenting the whole system.

With the other code (the XML Parser) I have added an xmlref field on the table and it seems to run fine for one go around, then I run into an error saying "too few variables"...

so in short... I am stuck:(
 
OK Allen,

I actually got the code to work... Previously I think I must have deleted something when trying to do the indention for it.

One thing that you may want to go back and edit... there is a space in the table name which should not be there on this line:

Set rstApplicationTableFieldDefinitions = dbs.OpenRecordset("Application_Table_Field_Definit ions", , dbAppendOnly)


If you look at "Application_Table_Field_Definit ions" there is an extra space. This won't throw an error out there, but it will prevent the table from being populated...

But thanks for the code! It rocks!!!

-G
 
edit: Glad its worked for you, just posted this with indentions but you beat me to it.


Create the following Table

Application_Table_Field_Definitions
txtField_Name (text 65)
txtTable_Name (text 65)
intSequence (integer)
txtDescription (text 100)
fPkey (yes/no)
txtType (text 35)
intLength (integer)

Code:
Private Sub Form_Load()

    DoCmd.Maximize

    GetTableDefinitions

End Sub

Sub GetTableDefinitions()

Dim dbs As Database
Dim rstApplicationTableFieldDefinitions As Recordset

Dim tdfDetails As TableDef
Dim fldDetails As Field
Dim idxDetails As Index

Dim strPrimaryKeyNames(1 To 10) As String

Dim intPrimaryKeyCount As Integer
Dim intPrimaryKeyCounter As Integer
Dim intProgressBarCounter As Integer

Dim varRtn As Variant
    
On Error Resume Next
    
    Set dbs = CurrentDb
    
    dbs.Execute ("Delete * From Application_Table_Field_Definitions")
    
    Set rstApplicationTableFieldDefinitions = dbs.OpenRecordset("Application_Table_Field_Definitions", , dbAppendOnly)
    
    varRtn = SysCmd(acSysCmdInitMeter, "Processing tables...", dbs.TableDefs.Count)
    
    For Each tdfDetails In dbs.TableDefs
        
        If (tdfDetails.Attributes And (dbSystemObject Or dbHiddenObject)) = 0 And _
            tdfDetails.Name <> "Application_Table_Field_Definitions" Then
            
            intPrimaryKeyCount = 0
            
            For Each idxDetails In tdfDetails.Indexes
                
                If idxDetails.Primary Then
                    
                    For Each fldDetails In idxDetails.Fields
                        
                        If intPrimaryKeyCount = 10 Then Exit For
                        
                        intPrimaryKeyCount = intPrimaryKeyCount + 1
                        
                        strPrimaryKeyNames(intPrimaryKeyCount) = fldDetails.Name
                    
                    Next fldDetails
                
                Exit For
                
                End If
            
            Next idxDetails
            
            For Each fldDetails In tdfDetails.Fields
                
                rstApplicationTableFieldDefinitions.AddNew
                
                rstApplicationTableFieldDefinitions!txtTable_Name = tdfDetails.Name
                
                rstApplicationTableFieldDefinitions!intSequence = fldDetails.OrdinalPosition
                
                rstApplicationTableFieldDefinitions!txtField_Name = fldDetails.Name
                
                rstApplicationTableFieldDefinitions!txtDescription = fldDetails.Properties("Description")
                
                For intPrimaryKeyCounter = 1 To intPrimaryKeyCount
                    
                    If fldDetails.Name = strPrimaryKeyNames(intPrimaryKeyCounter) Then
                        
                        rstApplicationTableFieldDefinitions!fPKey = True
                        
                        Exit For
                    
                    End If
                
                Next intPrimaryKeyCounter
                
                Select Case fldDetails.Type
                    
                    Case dbBoolean
                        
                        rstApplicationTableFieldDefinitions!txtType = "Yes/No"
                        rstApplicationTableFieldDefinitions!intLength = 1
                    
                    Case dbByte
                        
                        rstApplicationTableFieldDefinitions!txtType = "Byte"
                        rstApplicationTableFieldDefinitions!intLength = 1
                    
                    Case dbInteger
                        
                        rstApplicationTableFieldDefinitions!txtType = "Integer"
                        rstApplicationTableFieldDefinitions!intLength = 2
                    
                    Case dbLong
                        
                        If (fldDetails.Attributes And dbAutoIncrField) Then
                            
                            rstApplicationTableFieldDefinitions!txtType = "Auto Number"
                            
                        Else
                            
                            rstApplicationTableFieldDefinitions!txtType = "Long Integer"
                        
                        End If
                        
                        rstApplicationTableFieldDefinitions!intLength = 4
                    
                    Case dbCurrency
                        
                        rstApplicationTableFieldDefinitions!txtType = "Currency"
                        rstApplicationTableFieldDefinitions!intLength = 8
                    
                    Case dbSingle
                        
                        rstApplicationTableFieldDefinitions!txtType = "Single"
                        rstApplicationTableFieldDefinitions!intLength = 4
                    
                    Case dbDouble
                        
                        rstApplicationTableFieldDefinitions!txtType = "Double"
                        rstApplicationTableFieldDefinitions!intLength = 8
                    
                    Case dbDate
                        
                        rstApplicationTableFieldDefinitions!txtType = "Date/Time"
                        rstApplicationTableFieldDefinitions!intLength = 8
                    
                    Case dbText
                        
                        rstApplicationTableFieldDefinitions!txtType = "Text"
                        rstApplicationTableFieldDefinitions!intLength = fldDetails.Size
                    
                    Case dbLongBinary
                        
                        rstApplicationTableFieldDefinitions!txtType = "OLE Object"
                    
                    Case dbMemo
                        
                        rstApplicationTableFieldDefinitions!txtType = "Memo"
                    
                    Case dbGUID
                        
                        rstApplicationTableFieldDefinitions!txtType = "Replication ID"
                        rstApplicationTableFieldDefinitions!intLength = 16
                    
                    Case Else
                        
                        rstApplicationTableFieldDefinitions!txtType = "Unknown"
                
                End Select
                
                rstApplicationTableFieldDefinitions.Update
            
            Next fldDetails
        
        End If
        
        intProgressBarCounter = intProgressBarCounter + 1
    
        varRtn = SysCmd(acSysCmdUpdateMeter, intProgressBarCounter)
   
    Next tdfDetails
    
    varRtn = SysCmd(acSysCmdClearStatus)

    rstApplicationTableFieldDefinitions.Close
    dbs.Close
    
    Set rstApplicationTableFieldDefinitions = Nothing
    Set dbs = Nothing

    DoCmd.Close acForm, Me.FormName, acSaveYes

End Sub
 
Last edited:
do yuo mean me?

i will have another look at it all

it definitely worked in an app i had, but i cut out a lot of confidential stiuff to just leave the basic procedure.

i will test it again, and fix it.
 

Users who are viewing this thread

Back
Top Bottom