vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Datenbanken · DAO   |   VB-Versionen: VB4, VB5, VB609.08.01
Access nach dBASE

Diese Universalroutine kopiert eine ACCESS-Tabelle 1:1 in eine dBASE-Datenbank.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  28.258 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Die nachfolgende Routine entstammte wieder einmal einer aktuellen Foren-Anfrage. Es wurde gefragt, wie man eine Access-Datenbank-Tabelle in eine dBASE-Datenbank umwandeln kann.

Und hier das Ergebnis:

' Konvertiert eine ACCESS-Tabelle in eine dBASE-Datenbank
' 
' Parameter:
' ==========
' FilenameAccess : vollständiger Dateiname der Access-Datenbank
' TabNameAccess  : Name der zu konvertierenden Tabelle
' FilenameDBase  : vollständiger Dateiname der DBase-Datei
'   (falls nicht existiert, wird die dBASE-Datenabnk angelegt)
' DeleteIfExists : Gibt an ob die dBASE-Datenbank zunächst gelöscht
'    werden soll, falls sie bereits vorhanden ist
' 
' Rückgabewert:
' =============
' True, falls Kopiervorgang erfolgreich war
' False, wenn Fehler oder dBASE-Datei bereits existiert
'        und Parameter DeleteIfExists = False
' 
' ===============================================================
Private Function Copy_AccessToDBase(ByVal FilenameAccess As String, _
  ByVal TabNameAccess As String, ByVal FilenameDBase As _
  String, Optional ByVal DeleteIfExists As Boolean = True) As Boolean
 
  Dim dbDBase As Database
  Dim TabDBase As Recordset
  Dim dbAccess As Database
  Dim TabAccess As Recordset
  Dim PathDBase As String
  Dim NameDBase As String
  Dim TabDef As New TableDef
  Dim Feld As New Field
  Dim I As Integer
  Dim Dummy As String
  Dim AccessFeld As Field
 
  PathDBase = Left$(FilenameDBase, _
    InStrRev(FilenameDBase, "\") - 1)
  NameDBase = Mid$(FilenameDBase, Len(PathDBase) + 2)
  NameDBase = Left$(NameDBase, InStrRev(NameDBase, ".") - 1)
 
  On Local Error GoTo Copy_Access_Error
 
  ' Prüfen, ob dBASE-Datei bereits vorhanden
  If Dir$(FilenameDBase, vbNormal) <> "" Then
    If Not DeleteIfExists Then
      Copy_AccessToDBase = False
      Exit Function
    End If
    Kill FilenameDBase
  End If
 
  ' dBASE-Datei erstellen
  Set dbDBase = Workspaces(0).OpenDatabase(PathDBase, _
    False, False, "dBASE IV;")
 
  ' Access-Datenbank öffnen
  Set dbAccess = Workspaces(0).OpenDatabase(FilenameAccess)
  Set TabAccess = dbAccess.OpenRecordset(TabNameAccess)
 
  ' Tabellen-Definition übertragen
  TabDef.Name = NameDBase
  For Each AccessFeld In TabAccess.Fields
    With AccessFeld
      Feld.Name = .Name
      Feld.Type = .Type
      Select Case .Type
        Case dbMemo
          Feld.AllowZeroLength = .AllowZeroLength
        Case dbText
          Feld.Size = IIf(.Size >= 255, 254, .Size)
          Feld.AllowZeroLength = .AllowZeroLength
      End Select
      Feld.Attributes = .Attributes
      Feld.DefaultValue = .DefaultValue
      Feld.Required = .Required
    End With
    TabDef.Fields.Append Feld
    Set Feld = Nothing
  Next
  dbDBase.TableDefs.Append TabDef
 
  ' DBase-Tabelle öffnen
  Set TabDBase = dbDBase.OpenRecordset(NameDBase)
 
  ' Datensätze übertragen
  While Not TabAccess.EOF
    TabDBase.AddNew
    For I = 0 To TabAccess.Fields.Count - 1
      TabDBase(I) = TabAccess(I)
    Next I
    TabDBase.Update
 
    TabAccess.MoveNext
  Wend
  Copy_AccessToDBase = True
 
Copy_Access_End:
  On Local Error Resume Next
  TabDBase.Close: dbDBase.Close
  TabAccess.Close: dbAccess.Close
  On Local Error GoTo 0
  Exit Function
 
Copy_Access_Error:
  MsgBox "Fehler !!!" & vbCrLf & Err.Number & _
    " " & Err.Description, 16, "FEHLER..."
  Copy_AccessToDBase = False
  Resume Copy_Access_End
End Function

Erläuterungen:
Die Funktion erzeugt automatisch eine dBASE-Datenbank-Datei, falls diese (Parameter FilenameDBase) noch nicht vorhanden ist. Sollte die Datenbank bereits vorhanden sein, so kann über den Parameter DeleteIfExists festgelegt werden, ob diese zunächst gelöscht werden soll. Wird hier False als Parameter angegeben, wird die Routine erfolglos beendet (sollte die Datei bereits existieren).

Die einzelnen Feldbeschreibungen der Access-Tabelle werden 1:1 in die dBASE-Tabelle übertragen. Im Anschluß daran werden alle Datensätze der Access-Tabelle ebenfalls in die dBASE-Tabelle übertragen.

Tritt während des Übertragungs-Vorgangs ein Fehler auf, wird die Funktion beendet und False zurückgegeben. War alles erfolgreich wird True zurückgegeben.

Beispiel:
Nehmen wir an, Sie haben eine Access-Datenbank C:\myAccess\Adressen.mdb, welche eine Tabelle Adressen enthält. Diese Tabelle soll nun in eine dBASE-Datenbank namens C:\myDBASE\Adressen.dbf umgewandelt werden. Der Aufruf wäre dann so:

Copy_AccessToDBase "C:\myAccess\Adressen.mdb", _
  "Adresse", "C:\myDBase\Adressen.dbf", True

Dieser Tipp wurde bereits 28.258 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel