Save the names of tables, forms, and reports in a Microsoft Access database to a table named "ObjectNames. (1 Viewer)

Ramzi

New member
Local time
Today, 22:24
Joined
May 8, 2022
Messages
13
Public Sub SaveObjectNames()
On Error GoTo ErrorHandler

Dim db As DAO.Database
Dim obj As AccessObject
Dim strSQL As String
Dim rs As DAO.Recordset
Dim objectName As String

' Open the current database
Set db = CurrentDb

' Loop through each object in the current database and insert names into the table
For Each obj In db.AllTables
objectName = obj.Name
If Not IsObjectNameExist("Table", objectName) Then
InsertObjectName "Table", objectName
End If
Next obj

For Each obj In db.AllForms
objectName = obj.Name
If Not IsObjectNameExist("Form", objectName) Then
InsertObjectName "Form", objectName
End If
Next obj

For Each obj In db.AllReports
objectName = obj.Name
If Not IsObjectNameExist("Report", objectName) Then
InsertObjectName "Report", objectName
End If
Next obj

' Cleanup
Set obj = Nothing
Set db = Nothing

MsgBox "Object names have been saved to the table.", vbInformation
Exit Sub

ErrorHandler:
MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

Private Function IsObjectNameExist(ByVal objectType As String, ByVal objectName As String) As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String

Set db = CurrentDb
strSQL = "SELECT COUNT(*) AS CountOfRecords " & _
"FROM ObjectNames " & _
"WHERE ObjectType='" & objectType & "' AND ObjectName='" & objectName & "'"

Set rs = db.OpenRecordset(strSQL)
If Not rs.EOF Then
IsObjectNameExist = (rs!CountOfRecords > 0)
End If

rs.Close
Set rs = Nothing
Set db = Nothing
End Function

Private Sub InsertObjectName(ByVal objectType As String, ByVal objectName As String)
Dim db As DAO.Database
Dim strSQL As String

Set db = CurrentDb
strSQL = "INSERT INTO ObjectNames (ObjectType, ObjectName) " & _
"VALUES ('" & objectType & "', '" & objectName & "')"
db.Execute strSQL
Set db = Nothing
End Sub
 
Code:
Public Sub SaveObjectNames()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim obj As AccessObject
    Dim strSQL As String
    Dim rs As DAO.Recordset
    Dim objectName As String
    
    ' Open the current database
    Set db = CurrentDb
    
    ' Loop through each object in the current database and insert names into the table
    For Each obj In db.AllTables
        objectName = obj.Name
        If Not IsObjectNameExist("Table", objectName) Then
            InsertObjectName "Table", objectName
        End If
    Next obj
    
    For Each obj In db.AllForms
        objectName = obj.Name
        If Not IsObjectNameExist("Form", objectName) Then
            InsertObjectName "Form", objectName
        End If
    Next obj
    
    For Each obj In db.AllReports
        objectName = obj.Name
        If Not IsObjectNameExist("Report", objectName) Then
            InsertObjectName "Report", objectName
        End If
    Next obj
    
    ' Cleanup
    Set obj = Nothing
    Set db = Nothing
    
    MsgBox "Object names have been saved to the table.", vbInformation
    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

Private Function IsObjectNameExist(ByVal objectType As String, ByVal objectName As String) As Boolean
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    
    Set db = CurrentDb
    strSQL = "SELECT COUNT(*) AS CountOfRecords " & _
             "FROM ObjectNames " & _
             "WHERE ObjectType='" & objectType & "' AND ObjectName='" & objectName & "'"
    
    Set rs = db.OpenRecordset(strSQL)
    If Not rs.EOF Then
        IsObjectNameExist = (rs!CountOfRecords > 0)
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Function

Private Sub InsertObjectName(ByVal objectType As String, ByVal objectName As String)
    Dim db As DAO.Database
    Dim strSQL As String
    
    Set db = CurrentDb
    strSQL = "INSERT INTO ObjectNames (ObjectType, ObjectName) " & _
             "VALUES ('" & objectType & "', '" & objectName & "')"
    db.Execute strSQL
    Set db = Nothing
End Sub
 
What is not doing that you want it to?
Have you walked your code with F8 and breakpoints?
 
First of all, I don't understand your measure. All information (and some more) is already contained in the system table MSysObjects.
 
table names, form names, report names, etc. are already in table MsysObjects, why re-inventing it?
 
First of all, I don't understand your measure. All information (and some more) is already contained in the system table MSysObjects.
Actually i want to save the names in my own table to give the permission for users where authorized users can access the forms reports.
 
So use the correct syntax.? :( do not make names of properties up. See the link in post #9
 
Code:
SELECT * FROM MSysObjects
Take a look at this.

Then you take only the fields you need, and you filter out records other than the forms and reports and tables, and you can insert the rest into your table.
Whether this query is carried out by hand or by code is up to your skill.
 
You COULD drop us a hint... what error is reported when it fails? Or do you have error reporting somehow disabled despite having an ON ERROR trapper in place? The specific error should tell us more about what is happening. To ask "What is wrong" you HAVE to know our response will be "Specifically, how do you know something is wrong?"
 
You COULD drop us a hint... what error is reported when it fails? Or do you have error reporting somehow disabled despite having an ON ERROR trapper in place? The specific error should tell us more about what is happening. To ask "What is wrong" you HAVE to know our response will be "Specifically, how do you know something is wrong?"
 

Attachments

  • Error.JPG
    Error.JPG
    11.2 KB · Views: 55
Ramzi,

You might want to review some recent(Oct/23) work "List Access Objects" by Crystal (strive4peace). The video and accompanying application do what you are asking and much more. You can review/inspect her code in detail to learn various coding techniques.
 
You COULD drop us a hint... what error is reported when it fails? Or do you have error reporting somehow disabled despite having an ON ERROR trapper in place? The specific error should tell us more about what is happening. To ask "What is wrong" you HAVE to know our response will be "Specifically, how do you know something is wrong?"
OP appears to be mixing up properties ffrom different objects? :(

The AllTables collection contains an AccessObject for each table in the CurrentData or CodeData object.
Code:
Sub AllTables()
 Dim obj As AccessObject, dbs As Object
 Set dbs = Application.CurrentData
 ' Search for open AccessObject objects in AllTables collection.
 For Each obj In dbs.AllTables
 If obj.IsLoaded = True Then
 ' Print name of obj.
 Debug.Print obj.Name
 End If
 Next obj
End Sub
 

Users who are viewing this thread

Back
Top Bottom