Private Sub Command1_Click()
    Copy_AccessToDBase "C:Eigene DateienRalph.MDB", "Termine", "C:Eigene" & _
      "DateienDBASE.DBF", True
End Sub
 
 
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