Option Explicit
Public FSO As New FileSystemObject
 
Private Sub cmdAusführen_Click()
On Error GoTo Ausführen_Catch
 
Dim Rs As New ADODB.Recordset
Dim Cn As New ADODB.Connection
Dim Fi As Field
Dim i  As Integer
Dim sMsg As String
 
 
    Select Case cbbTyp.ListIndex
    'access 97
    Case 0
 
    With Cn
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.3.5"
        .ConnectionString = "Data Source=" & txtPfad.Text
 
    End With
 
    'access 2000
    Case 1
     With Cn
        .CursorLocation = adUseClient
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & txtPfad.Text
    End With
 
    'oracle
    Case 2
 
    'sql-server
    Case 3
       With Cn
      .Provider = GetProvider(cbbTyp.ListIndex)
      .ConnectionString = "Data Source=" & txtServerName.Text & ";" & _
      "User Id=" & txtBenutzer.Text & ";" & _
      "Password=" & txtPasswort.Text & ";"
    End With
 
    End Select
 
    Cn.Open
 
 
    Set Rs = ExecuteSQL(txtSQL.Text, Cn)
 
 
    If IsNull(Rs) = False Then
        Set frmTabelle.Flex1.DataSource = Rs
        For Each Fi In Rs.Fields
            frmTabelle.tbTabelle.Buttons(1).ButtonMenus.Add , Fi.Name, Fi.Name
        Next
        frmTabelle.Show (vbModal)
    End If
 
 
Ausführen_Finalize:
    Cn.Close
    Exit Sub
 
Ausführen_Catch:
  With Cn
     For i = 0 To .Errors.Count - 1
       sMsg = sMsg & .Errors(i).Description & vbCrLf
     Next i
     .Errors.Clear
  End With
  MsgBox sMsg, vbCritical, "Datenbankfehler"
 
 
End Sub
 
Private Sub cmdLaden_Click()
    frmSQLÖffnen.Show (vbModal)
End Sub
 
Private Sub cmdSpeichern_Click()
Dim BaseDir As Folder
Dim Stream As TextStream
Dim Datei As String
 
    Datei = InputBox("Geben Sie den Namen ein", "Speicher...")
    Set BaseDir = FSO.GetFolder(App.Path)
 
    Set Stream = BaseDir.CreateTextFile(Datei & ".sql", True)
    Stream.Write (txtSQL.Text)
End Sub
 
Private Sub cmdSQLEditor_Click()
    frmSQLEditor.Show (vbModal)
End Sub
 
Private Sub cmndDurchsuchen_Click()
On Error Resume Next
 
    cdOpen.ShowOpen
    If Err.Number Then Exit Sub
    txtPfad.Text = cdOpen.FileName
    If txtPfad.Text = "" Then Exit Sub
    txtPfad.SelStart = Len(txtPfad.Text)
 
    Select Case Endung(txtPfad.Text)
    Case "mdb"
        cbbTyp.ListIndex = dtAccess2000
    Case "MDB"
        cbbTyp.ListIndex = dtAccess2000
    Case "sdb"
        cbbTyp.ListIndex = dtSQLServer
    Case "ora"
        cbbTyp.ListIndex = dtOracle
    Case Default
        cbbTyp.ListIndex = dtAccess97
    End Select
End Sub
 
Private Sub Form_Load()
    cbbTyp.ListIndex = dtAccess97
End Sub

Option Explicit
 
Public Enum DriverTypeEnumeration
    dtAccess97 = 0
    dtAccess2000 = 1
    dtOracle = 2
    dtSQLServer = 3
End Enum
 
Public Function GetProvider(DType As DriverTypeEnumeration)
    Select Case (DType)
        Case dtAccess2000
            GetProvider = "Microsoft.Jet.OLEDB.4.0"
        Case dtAccess97
            GetProvider = "Microsoft.Jet.OLEDB.3.51"
        Case dtSQLServer
            GetProvider = "SQLOLEDB.1"
        Case dtOracle
            GetProvider = "MSDAORA"
    End Select
End Function
 
Public Function Endung(Datei As String) As String
Dim Z As Integer
 
    For Z = Len(Datei) To 0 Step -1
        If Mid(Datei, Z, 1) = "." Then
            Endung = Right(Datei, Len(Datei) - Z)
            Exit Function
        End If
    Next Z
End Function
 
Public Function ExecuteSQL(SQL As String, Connection As ADODB.Connection) As _
  ADODB.Recordset
Dim cmd As New ADODB.Command
    cmd.CommandType = adCmdText
    cmd.CommandText = SQL
    Set cmd.ActiveConnection = Connection
    Set ExecuteSQL = cmd.Execute
End Function