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
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