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