Tipp 0322 Datenbank erstellen (ADO)
Autor/Einsender:
Datum:
  Markus Schutz
25.03.2003
Entwicklungsumgebung:   VB 6
Dieses Beispiel zeigt, wie mit dem ADO-Datenzugriffsmodell eine neue Access 2000-Datenbank erstellt wird, und neben Tabellen auch weitere neue Felder mit SQL-Anweisungen hinzugefügt werden können.
 
Option Explicit

Private m_strDBFileName As String

Private Sub Form_Load()
  Dim strAppPath As String

  strAppPath = App.Path
  If Right$(strAppPath, 1) <> "\" Then
    strAppPath = strAppPath & "\"
  End If
  m_strDBFileName = strAppPath & "Datenbank.mdb"

  If FileExists(m_strDBFileName) = True Then
    Kill m_strDBFileName
  End If
End Sub

Private Sub cmdCreateDB_Click()
  On Error GoTo err_flash

  Create_DB m_strDBFileName
  lblStatus.Caption = "Datenbank erfolgreich erstellt."
  Exit Sub

err_flash:
  lblStatus.Caption = Err.Description
End Sub

Private Sub Create_DB(ByVal vsFileName As String)
  Dim objCatalog As Object

  Set objCatalog = CreateObject("ADOX.Catalog")
  objCatalog.Create "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=" & vsFileName
  Set objCatalog = Nothing
End Sub

Private Sub cmdCreateTable_Click()
  DB_Handler "Create_Table"
End Sub

Private Sub cmdDelTable_Click()
  DB_Handler "Delete_Table"
End Sub

Private Sub cmdAddColumn_Click()
  DB_Handler "Add_New_Column"
End Sub

Private Sub cmdDelColumn_Click()
  DB_Handler "Del_Column"
End Sub

Private Sub DB_Handler(ByVal vsAction As String)
  Dim objConn As ADODB.Connection
  Dim strSQL As String

  If FileExists(m_strDBFileName) = False Then
    MsgBox "Datenbank nicht gefunden", vbCritical, "Fehler"
    Exit Sub
  End If

  On Error GoTo err_flash
  Set objConn = New ADODB.Connection
  With objConn
    .CursorLocation = adUseClient
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Data Source") = m_strDBFileName
    .Open
  End With

  Select Case vsAction
    Case "Create_Table"
      strSQL = "CREATE TABLE tbl_Neu (ID  COUNTER  NOT NULL " & _
               "CONSTRAINT   PK_ID_no   PRIMARY KEY, " & _
               "Comment      TEXT, " & _
               "NumericField LONG      DEFAULT 10, " & _
               "TextField    TEXT(20))"
    Case "Delete_Table"
      strSQL = "DROP TABLE tbl_Neu"
    Case "Add_New_Column"
      strSQL = "ALTER TABLE tbl_Neu ADD COLUMN Neue_Spalte MEMO"
    Case "Del_Column"
      strSQL = "ALTER TABLE tbl_Neu DROP COLUMN Neue_Spalte"
    Case Else
  End Select

  objConn.Execute strSQL
  objConn.Close
  Set objConn = Nothing

  Select Case vsAction
    Case "Create_Table"
      lblStatus.Caption = "Tabelle erfolgreich erstellt."
    Case "Delete_Table"
      lblStatus.Caption = "Tabelle erfolgreich gelöscht."
    Case "Add_New_Column"
      lblStatus.Caption = "Neue Spalte erstellt."
    Case "Del_Column"
      lblStatus.Caption = "Spalte erfolgreich gelöscht."
    Case Else
      lblStatus.Caption = Err.Description
  End Select
  On Error GoTo 0
  Exit Sub

err_flash:
  lblStatus.Caption = Err.Description
End Sub

Private Sub cmdKillDB_Click()
  On Error GoTo err_flash
  If FileExists(m_strDBFileName) = True Then
    Kill m_strDBFileName
  End If
  lblStatus.Caption = "Datenbank erfolgreich gelöscht."
  Exit Sub

err_flash:
  lblStatus.Caption = Err.Description
End Sub

Private Function FileExists(ByVal vsFileName As String) As Boolean
  Dim strFile As String

  FileExists = False
  On Error Resume Next
  strFile = Dir$(vsFileName)
  If (Len(strFile) > 0) And (Err = 0) Then
    FileExists = True
  End If
  On Error GoTo 0
End Function
 
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft ActiveX Data Objects 2.5 Library in das Projekt eingebunden werden.
Weitere Links zum Thema
Connection-String dynamisch erzeugen
Datenbank erstellen (DAO)

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5 kB) Downloads bisher: [ 4496 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 27. August 2011