vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 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, VB606.05.01
dBASE nach Access

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

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  19.783 
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 DBase-Datei in eine ACCESS-Datenbank umwandeln kann.

Und hier das Ergebnis:

' Konvertiert eine dBase-Datei in eine Access-Datenbank
' 
' Parameter:
' ==========
' FilenameDBase  : vollständiger Dateiname der DBase-Datei
' FilenameAccess : vollständiger Dateiname der Access-Datenbank
'   (falls nicht existiert, wird die Access-Datenabnk angelegt)
' DeleteIfExists : Gibt an ob die Access-Tabelle zunächst gelöscht
'    werden soll, falls sie bereits vorhanden ist
' 
' Rückgabewert:
' =============
' True, falls Kopiervorgang erfolgreich war
' False, wenn Fehler oder Access-Tabelle bereits existiert
'        und Parameter DeleteIfExists = False
' 
' ===============================================================
Private Function Copy_dBaseToAccess(ByVal FilenameDBase As _
 String, ByVal FilenameAccess 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
 
  PathDBase = Left$(FilenameDBase, _
    InStrRev(FilenameDBase, "\") - 1)
  NameDBase = Mid$(FilenameDBase, Len(PathDBase) + 2)
  NameDBase = Left$(NameDBase, InStrRev(NameDBase, ".") - 1)
 
  ' dBASE-Datei öffnen
  Set dbDBase = Workspaces(0).OpenDatabase(PathDBase, _
    False, False, "dBASE IV;")
  Set TabDBase = dbDBase.OpenRecordset(NameDBase)
 
  ' ACCESS-Datei erstellen
  If Dir(FilenameAccess) = "" Then
    Set dbAccess = Workspaces(0).CreateDatabase(FilenameAccess, _
      dbLangGeneral, dbEncrypt)
  Else
    Set dbAccess = Workspaces(0).OpenDatabase(FilenameAccess)
  End If
 
  ' Prüfen, ob Tabelle vorhanden
  On Local Error Resume Next
  Dummy = dbAccess.TableDefs(NameDBase).Name
  If Err.Number = 0 Then
    ' Tabelle existiert bereits !!!
    If DeleteIfExists Then
      dbAccess.TableDefs.Delete NameDBase
    Else
      Copy_dBaseToAccess = False
      Goto Copy_dBase_End
    End If
  End If
 
  Err.Number = 0
  On Local Error GoTo Copy_dBase_Error
 
  ' Tabellen-Definition übertragen
  TabDef.Name = NameDBase
  For I = 0 To TabDBase.Fields.Count - 1
    With TabDBase.Fields(I)
      Feld.Name = .Name
      Feld.Type = .Type
      Feld.Size = .Size
      Feld.AllowZeroLength = .AllowZeroLength
      Feld.Attributes = .Attributes
      Feld.DefaultValue = .DefaultValue
      Feld.Required = .Required
    End With
    TabDef.Fields.Append Feld
    Set Feld = Nothing
  Next I
  dbAccess.TableDefs.Append TabDef
 
  ' Access-Tabelle öffnen und Datensätze übertragen
  Set TabAccess = dbAccess.OpenRecordset(NameDBase)
 
  While Not TabDBase.EOF
    TabAccess.AddNew
    For I = 0 To TabDBase.Fields.Count - 1
      TabAccess(I) = TabDBase(I)
    Next I
    TabAccess.Update
 
    TabDBase.MoveNext
  Wend
  Copy_dBaseToAccess = True
 
Copy_dBase_End:
  On Local Error Resume Next
  TabDBase.Close: dbDBase.Close
  TabAccess.Close: dbAccess.Close
  On Local Error GoTo 0
  Exit Function
 
Copy_dBase_Error:
  MsgBox "Fehler !!!" & vbCrLf & Err.Number & _
    " " & Err.Description, 16, "FEHLER..."
  Copy_dBaseToAccess = False
  Resume Copy_dBase_End
End Function

Erläuterungen:
Die Funktion erzeugt automatisch eine Access-Datenbank-Datei, falls diese (Parameter FilenameAccess) noch nicht vorhanden ist. Ebenso wird eine Tabelle innerhalb der Access-Datenbank erstellt - mit dem Namen der dBase-Datei. Sollte die Tabelle 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 Tabelle bereits existieren).

Die einzelnen Feldbeschreibungen der dBase-Datei werden 1:1 in die Access-Tabelle übertragen. Im Anschluß daran werden alle Datensätze der dBase-Datei ebenfalls in die Access-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 möchten die DBase-Datei C:\dBASE\Adressen.dbf in eine Access-Datenbank "umwandeln". Der Aufruf wäre dann so:

Copy_dBaseToAccess "C:\dBASE\Adressen.dbf", _
  "C:\dBASE\Adressen.mdb", True

Es würde demnach eine Datei C:\dBASE\Adressen.mdb und innerhalb der Access-Datenbank eine Tabelle Adressen erstellt.
 

Dieser Tipp wurde bereits 19.783 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.

Aktuelle Diskussion anzeigen (1 Beitrag)

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