Hi !
I'm using a VBA function in Access XP (.mdb file) to enumerate all the relations in the database and to fill in a metadata table that holds the relations' attributes, tables names , fields names and so on.
I have a problem, though. The "For Each rel In ...Relations" loop runs very slow (the entire loop runs in about 30 seconds although i have only 8 relations in the db).
I mention that I first build a matrix with the relations' metadata, then I'm uploading the matrix into a table.
Thanks.
- Chris
I'd be interested in this function....very useful, I've just never felt like doing it myself. Please post...please, please, please?
Hi everybody !
I was able to identify the bottleneck in the code: it is caused by the PartialReplica property of the DAO.Relation object.
It seems that the access to the Relation object's properties goes fast except access to the above mentioned property. On my system (P4 2.53 GHz ; 1GB RAM), each access to the PartialReplica property takes four seconds. The tables do not belong to a replica set.
- Chris
Try setting a DAO.Database object reference, rather than going all the way back to the Application object in the loop.
If that doesn't work, step through the code and let us know where the exact slow-down is occurring. On its way to obsoletion, I suspect that DAO in XP is even worse than in 2000, though I don't use it so I don't know myself
Hi !
Here's your candy: (couldn't attach it to the post; i think there's a bug in this site)
>>>>>>>>>>>
These are in a standard module:
<<<<<<<<<<
Option Compare Database
Option Explicit
Python vs. Perl vs. Java vs. C++ Runtimes::
Even the eventloop was inside Python, and the app was running very fast. Longwinded syntax makes it slow going, but helps produce solid code.
http://furryland.org/~mikec/benchHOME |
Public Function FillRelationsMetaData()
On Error GoTo Err_FillRelationsMetaData
Dim rel As DAO.Relation, _
tdef_metadata As DAO.TableDef, _
fld As DAO.Field
Dim rs As DAO.Recordset
Dim aRelations
Dim lIdx As Long, I As Long
Set tdef_metadata = Application.DBEngine.Workspaces(0).Databases(0).Ta bleDefs("RelationsMetaData")
Set rs = tdef_metadata.OpenRecordset(dbOpenDynaset)
While rs.EOF = False
rs.Delete
rs.MoveNext
Wend
rs.Close
lIdx = 0
ReDim aRelations(12, 10)
For Each rel In Application.DBEngine.Workspaces(0).Databases(0).Re lations
For Each fld In rel.Fields
If lIdx > UBound(aRelations, 2) Then
ReDim Preserve aRelations(12, lIdx + 11)
End If
If rel.Attributes And dbRelationUnique Then
aRelations(0, lIdx) = -1
Else
aRelations(0, lIdx) = 0
End If
If rel.Attributes And dbRelationDontEnforce Then
aRelations(1, lIdx) = -1
Else
aRelations(1, lIdx) = 0
End If
If rel.Attributes And dbRelationInherited Then
aRelations(2, lIdx) = -1
Else
aRelations(2, lIdx) = 0
End If
If rel.Attributes And dbRelationUpdateCascade Then
aRelations(3, lIdx) = -1
Else
aRelations(3, lIdx) = 0
End If
If rel.Attributes And dbRelationDeleteCascade Then
aRelations(4, lIdx) = -1
Else
aRelations(4, lIdx) = 0
End If
If rel.Attributes And dbRelationLeft Then
aRelations(5, lIdx) = -1
Else
aRelations(5, lIdx) = 0
End If
If rel.Attributes And dbRelationRight Then
aRelations(6, lIdx) = -1
Else
aRelations(6, lIdx) = 0
End If
aRelations(7, lIdx) = Nz(rel.ForeignTable, "")
aRelations(8, lIdx) = Nz(rel.Name, "")
If rel.PartialReplica Then
aRelations(9, lIdx) = -1
Else
aRelations(9, lIdx) = 0
End If
aRelations(10, lIdx) = Nz(rel.Table, "")
aRelations(11, lIdx) = Nz(fld.Name, "")
aRelations(12, lIdx) = Nz(fld.ForeignName, "")
lIdx = lIdx + 1
Next
Next
'''''''''''''''''''''''''
Set rs = tdef_metadata.OpenRecordset(dbOpenTable, dbAppendOnly)
For I = 0 To lIdx - 1
rs.AddNew
rs.Fields("OneToOne") = aRelations(0, I)
rs.Fields("NoDRI") = aRelations(1, I)
rs.Fields("NotInThisDb") = aRelations(2, I)
rs.Fields("UpdateCascade") = aRelations(3, I)
rs.Fields("DeleteCascade") = aRelations(4, I)
rs.Fields("LeftJoin") = aRelations(5, I)
rs.Fields("RightJoin") = aRelations(6, I)
rs.Fields("ForeignTable") = aRelations(7, I)
rs.Fields("Name") = aRelations(8, I)
rs.Fields("PartialReplica") = aRelations(9, I)
rs.Fields("PrimaryTable") = aRelations(10, I)
rs.Fields("FieldName") = aRelations(11, I)
rs.Fields("FieldForeignName") = aRelations(12, I)
rs.Update
Next
rs.Close
MsgBox "FillRelationsMetaData finished"
FillRelationsMetaData = True
Exit_FillRelationsMetaData:
Exit Function
Err_FillRelationsMetaData:
MsgBox "[MEntUtils::FillRelationsMetaData]" & vbCr & Err.Description, vbCritical
FillRelationsMetaData = False
Resume Exit_FillRelationsMetaData
End Function
Public Function DeleteAllRows() As Boolean
Dim tname As String
On Error GoTo Err_DeleteAllRows
tname = InputBox("Please enter the table name you wish to truncate", "Test Access", "")
If tname = "" Then
MsgBox "No name was given"
DeleteAllRows = True
Exit Function
End If
Dim tdef As DAO.TableDef
Dim rs As DAO.Recordset
Set tdef = Application.DBEngine.Workspaces(0).Databases(0).Ta bleDefs(tname)
Set rs = tdef.OpenRecordset(dbOpenDynaset)
While rs.EOF = False
rs.Delete
rs.MoveNext
Wend
rs.Close
MsgBox "Table " & tname & " was truncated"
DeleteAllRows = True
Exit_DeleteAllRows:
Exit Function
Err_DeleteAllRows:
MsgBox "[MEntUtils::DeleteAllRows]" & vbCr & Err.Description, vbCritical
DeleteAllRows = False
Resume Exit_DeleteAllRows
End Function
>>>>>>>>>>
Create a macro named with this content:
RunCode FillRelationsMetaData ()
<<<<<<<<<<<
Please create a file named RelationsMetaData.xsd with this content and import it in the RelationsMetaData table in the Access .mdb file :
>>>>>>>>>>
---------------------------
>>>>>>>>>>>
>>>>>>>>>>>>>
Create some tables and relationships and run the macro you've created. You should then have the metadata in RelationsMetaData table.
Enjoy and please reply !
- Chris
The .xsd file content magically disappeared from the post.
You'd better send me an e-mail or a Private Message and I'll reply with the .mdb file, OK ?
- chris
 I Am a Sinner – What About You?
 Global Sourcing and Supplier Online by Dylan
|
Code Runs Very Slow