DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Command1_Click()
Call ExportDatabaseObjects1
End Sub
Private Function ExportDatabaseObjects1()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
'Dim db As DAO.Database
Dim td As TableDef
Dim d As Document
Dim c As Container
Dim i As Integer
Dim qry As String
Set db = CurrentDb()
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
Call kayıt(td.Name, "Tablo")
End If
Next td
Set c = db.Containers("Forms")
For Each d In c.Documents
Call kayıt(d.Name, "Form")
Next d
Set c = db.Containers("Reports")
For Each d In c.Documents
Call kayıt(d.Name, "Rapor")
Next d
Set c = db.Containers("Scripts")
For Each d In c.Documents
Call kayıt(d.Name, "Script")
Next d
Set c = db.Containers("Modules")
For Each d In c.Documents
Call kayıt(d.Name, "Modül")
Next d
For i = 0 To db.QueryDefs.Count - 1
qry = db.QueryDefs(i).Name
Call kayıt(qry, "Sorgu")
Next i
Set db = Nothing
Set c = Nothing
Exit_ExportDatabaseObjects:
Exit Function
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Function
Public Sub kayıt(adı As String, türü As String)
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("Table1", dbOpenDynaset)
rs.AddNew
rs(1) = adı
rs(2) = türü
rs.Update
rs.Close
db.Close
End Sub