Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0580: Erweiterter Datenbankzugriff mittels ADO

VB 5/6-Tipp 0580: Erweiterter Datenbankzugriff mittels ADO

 von Stefan Maag

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [11,86 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Es muss ein Verweis auf 'Microsoft ADO Ext. 2.7 for DDL and Security' gesetzt werden.
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.0 Library' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Listen-Steuerelement "List1"
Option Explicit

Private Sub Command1_Click()
  'Tabelle löschen
  If List1.ListIndex = -1 Then Exit Sub
  DeleteTable List1, con
  
  List
End Sub

Private Sub Command2_Click()
  'Neue Tabele anlegen
  
  Dim t As ADOx.Table
  
  Set t = New ADOx.Table
  
  If Len(Text1) = 0 Then Exit Sub
    
  CreateTable t, con, Text1
  
  Set t = Nothing
  
  List
End Sub

Private Sub Form_Load()
  Set con = New ADODB.Connection
  
  With con
     .CursorLocation = adUseClient
     .Mode = adModeShareDenyNone
     .Provider = "Microsoft.Jet.OLEDB.4.0"
     .ConnectionString = "Data Source=" & App.Path & "\test.mdb"
     .Open
  End With
  
  List
End Sub

Private Sub List()
  Dim tlist() As String
  Dim i As Integer
  
  ListTableNames con, tlist()
  
  List1.Clear
  
  For i = 0 To UBound(tlist) - 1
    List1.AddItem tlist(i)
  Next i
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Set con = Nothing
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

' ***************************************************************************************
'     NAME: mdADOX
'     DESC: Modul zum erweiterten Datenbankzugriff mit ADO-Connection
'     DESC: Modul for extended access to databases with ADO-Connection
' ***************************************************************************************
'
'     AUTHOR:  Stefan Maag
'     EMAIL:   maag@odn.de
'     WEBSITE:
'     COUNTRY: Germany
'     CREATE:  11/2000
'     CHANGE:  28/02/2003 - Deutsche Kommentare hinzgefügt
'     COPY:    2000, by Stefan Maag
'     COPY:    this code is free for use
'     COPY:
'
' ===========================================================================
'  REM: Quellenangaben / Used Sources
' ===========================================================================
'  REM: MSDN Library

' ===========================================================================
'  REM: Weitere benötigte Dateien: / further Files
' ===========================================================================
'  use the Microsoft ADO Ext. 2.x for DLL and Security
'  unter Projekt Verweise, die Microsoft ADOX Ext. 2.x Bibliothek einbinden

Option Explicit

Public con As ADODB.Connection

' ===========================================================================
'  NAME: CreateTable
'  DESC: erzeugt eine Tabelle. Wird TableName nicht übergeben, wird
'  DESC: Table.Name als Tabellenname verwendet
'  DESC: Create a Table: if the Variable TableName is empty
'  DESC: the Table.Name is used as TableName
' ===========================================================================

Public Function CreateTable(Table As ADOx.Table, ADOConnection As ADODB.Connection, _
                            Optional ByVal TableName As String = "") As Boolean
   
   Dim cat As New ADOx.Catalog
   Dim tblName As String
   
   On Error Resume Next
   
   Err.Clear
   
   If TableName <> "" Then
      tblName = TableName
   Else
      tblName = Table.Name
   End If
   
   If tblName <> "" Then
      If Not TableExist(tblName, ADOConnection) Then
         Set cat.ActiveConnection = ADOConnection
         Table.Name = tblName
         cat.Tables.Append Table                     ' create the table
         CreateTable = (Err = 0)                     ' check on error
         Debug.Print Err, Err.Description
      End If
   Else
      CreateTable = False
   End If
   
End Function

' ===========================================================================
'  NAME: DelteTable
'  DESC: löscht eine Tabelle
'  DESC: delete a table
' ===========================================================================

Public Function DeleteTable(ByVal TableName As String, _
                            ADOConnection As ADODB.Connection) As Boolean
   Dim sName As String
   Dim cat As New ADOx.Catalog
   
   On Error Resume Next
   Set cat.ActiveConnection = ADOConnection        ' Set the catalogs connection
   
   If TableExist(TableName, ADOConnection) Then    ' if table exists
      Err.Clear
      cat.Tables.Delete TableName                  ' delete the table
      DeleteTable = (Err = 0)                      ' check on Error = 0
   Else
      DeleteTable = False
   End If
   
 End Function

' ===========================================================================
'  NAME: ListTableNames
'  DESC: Listet die Namen aller Standard-Tabellen in der Connection
'  DESC: und gibt die Anzahl der StandardTabellen zurück
'  DESC: List the names of all standard tables in the connection
'  DESC: and give back the number of standard tables
' ===========================================================================

Public Function ListTableNames(ADOConnection As ADODB.Connection, _
                               TableList() As String) As Long
   Dim tbl As New ADOx.Table
   Dim cat As New ADOx.Catalog
   
   Dim cnt As Long
   
   Const defTableType = "TABLE"                 ' TypeName Standard Table
   
   Set cat.ActiveConnection = ADOConnection     ' Set the catalogs connection
   
   cnt = cat.Tables.Count                       ' number of all tables in the connection
   
   ReDim TableList(cnt)                         ' Array for all TableNames
   
   cnt = 0
   For Each tbl In cat.Tables                   ' All tables including system tables
      If tbl.Type = defTableType Then           ' If table is standard table
         TableList(cnt) = tbl.Name
         cnt = cnt + 1
      End If
   Next
   ReDim Preserve TableList(cnt)
      
   ListTableNames = cnt                         ' give back the number of standard tables
End Function

' ===========================================================================
'  NAME: TableExist
'  DESC: prüft ob die Tabelle mit dem angegebenen Namen existiert
'  DESC: check the existing of the table by TableName
' ===========================================================================

Public Function TableExist(ByVal TableName As String, ADOConnection As ADODB.Connection) As Boolean
   Dim sName As String
   Dim cat As New ADOx.Catalog
   
   Set cat.ActiveConnection = ADOConnection     ' Set the catalogs connection
   
   On Error Resume Next
   Err.Clear                                    ' Clear Errors
   sName = cat.Tables(TableName).Name           ' produce an error, if table does not exist
   
   TableExist = (Err = 0)                       ' check on Error = 0
End Function

' Folgendes ist nur für Test gedacht.
' The following is only for testing

Public Function CreateTableDef(ByVal TableName As String) As ADOx.Table
   Dim New_Table As New ADOx.Table
   
   With New_Table
      .Name = TableName
      .Columns.Append "ID", adInteger
      .Columns.Append "Title", adVarWChar, 50
      .Columns.Append "Message", adLongVarWChar
      ' .Keys.Append "ID", adKeyPrimary
   End With
        
   Set CreateTableDef = New_Table
End Function

Public Sub Test(ByVal TableName As String, ADOConnection As ADODB.Connection)
   
   Dim tbl As ADOx.Table
   Dim cat As New ADOx.Catalog
   Dim key As ADOx.key
   
   Set cat.ActiveConnection = ADOConnection     ' Set the catalogs connection
      
   Set tbl = CreateTableDef(TableName)
   
   CreateTable tbl, ADOConnection
End Sub
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.