Tipp 0422 Tabellen in Datenbank analysieren (DAO)
Autor/Einsender:
Datum:
  Michael Werner
24.10.2004
Entwicklungsumgebung:   VB 6
Dieser Tipp zeigt, wie eine Access-Datenbank analysiert werden kann. Neben den Informationen der enthaltenen Tabellen, werden auch weitere Informationen wie Tabellenspalten, Datentyp und Größe der einzelnen Felder angezeigt. Als Besonderheit bietet dieser Tipp ein "echtes" Drag & Drop.
 
Option Explicit

Private Declare Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
    ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1

Private Sub Form_Load()
  SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Sub

Private Sub Command1_Click()
  Dim sDBFileName As String

  sDBFileName = Durchsuchen
  If sDBFileName = "" Then Exit Sub

  Me.Caption = "Analyse: " & sDBFileName
  DatenbankAnalysieren (sDBFileName)
End Sub

Private Sub DatenbankAnalysieren(p As String)
  On Error GoTo ErrorHandle

  Dim sDB As String

  Dim i As Integer
  Dim j As Integer

  Dim db As Database
  Dim rs As Recordset
  Dim td As TableDef
  Dim fd As Field

  Dim sMDBPath As String
  Dim sTables As String

  Set db = Workspaces(0).OpenDatabase(p)
  sMDBPath = "Datenbank: " & _
         Mid(db.Name, InStrRev(db.Name, "\") + 1) & vbNewLine & _
         db.Name & vbNewLine & vbNewLine

  For i = 0 To db.TableDefs.Count - 1
    Set td = db.TableDefs(i)

    If Left(td.Name, 4) <> "MSys" Then

      sDB = sDB & vbNewLine & Space(3) & "TABELLE: "
      sDB = sDB & td.Name & vbNewLine & vbNewLine

      sTables = sTables & vbNewLine & td.Name

      For j = 0 To td.Fields.Count - 1
        Set fd = td.Fields(j)
        sDB = sDB & Space(6) & "SPALTE: "
        sDB = sDB & fd.Name & vbCrLf

        sDB = sDB & Space(9) & "Datentyp: "
        Select Case fd.Type
          Case dbBoolean
            sDB = sDB & "Boolean" & vbCrLf
          Case dbByte
             sDB = sDB & "Byte" & vbCrLf
          Case dbInteger
            sDB = sDB & "Integer" & vbCrLf
          Case dbLong
            sDB = sDB & "Long" & vbCrLf
          Case dbCurrency
            sDB = sDB & "Currency" & vbCrLf
          Case dbSingle
            sDB = sDB & "Single" & vbCrLf
          Case dbDouble
            sDB = sDB & "Double" & vbCrLf
          Case dbDate
            sDB = sDB & "Date" & vbCrLf
          Case dbText
            sDB = sDB & "Text" & vbCrLf
          Case dbLongBinary
            sDB = sDB & "LongBinary" & vbCrLf
          Case dbMemo
            sDB = sDB & "Memo" & vbCrLf
          Case Else
            sDB = sDB & "(unknown) & vbCrLf"
        End Select

        If fd.Type <> dbLongBinary And fd.Type <> dbMemo Then
          sDB = sDB & Space(9) & "Größe in Bytes: "
          sDB = sDB & fd.Size & vbCrLf
        End If
       Next j
     End If
   Next i

   db.Close

   sTables = "Alle TABELLEN:" & vbNewLine & sTables
   txtDB.Text = sMDBPath & sTables & vbNewLine & vbNewLine & sDB

   Me.SetFocus
   Exit Sub

ErrorHandle:
  If Err.Number = cdlCancel Then
    Err.Clear
  Else
    MsgBox "Fehler: " & Err.Number & vbCrLf & _
            Err.Description, vbOKOnly, Me.Caption
  End If
End Sub

Private Function Durchsuchen() As String
  On Error GoTo ErrorHandle

  With CommonDialog1
    .CancelError = True
    .DialogTitle = "Wählen Sie eine Datenbank"
    .Filter = "Access-datenbanken(*.mdb)|*.mdb"
    .ShowOpen
    Durchsuchen = .FileName
  End With

  Exit Function

ErrorHandle:
  If Err.Number = cdlCancel Then
    Err.Clear
  Else
    MsgBox "Fehler: " & Err.Number & vbCrLf & _
            Err.Description, vbOKOnly, Me.Caption
  End If
End Function

Private Sub txtDB_OleDragDrop(Data As DataObject, _
        Effect As Long, Button As Integer, _
        Shift As Integer, x As Single, y As Single)
  Dim f

  If Not Data.GetFormat(vbCFFiles) Then Exit Sub

  For Each f In Data.Files
    If LCase(Right(f, 3)) = "mdb" Then
      DatenbankAnalysieren CStr(f)
      Exit Sub
    End If
  Next
End Sub
 
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft DAO 3.x Object Library in das Projekt eingebunden werden.

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  (4,1 kB) Downloads bisher: [ 1418 ]

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, 25. Juni 2011