Dim tdfNew As TableDef, fldTemp As Field
 
   '----- connection öffnen -----------
   Dim wrkODBC As Workspace, WebSQLCon As Connection, WebSQLSet As Recordset
   Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "Admin", "", dbUseODBC)
   Set WebSQLCon = wrkODBC.OpenConnection("", , , _
     "ODBC;DATABASE=KompaShop_All;UID=KompaShop_SQL_3r5z;PWD=schmidt;DSN=Kompa" & _
     "hop")
 
   '----- Tabels die gesichert werden sollen -----
   SQL = "select name from sysobjects where name not like 'Sys%'"
   Set WebSQLSet = WebSQLCon.OpenRecordset(SQL, dbOpenDynaset)
   Do Until WebSQLSet.EOF
      TS = TS & WebSQLSet!Name & ";"
      WebSQLSet.MoveNext
   Loop
   Table = Split(TS, ";")
 
   '---- Access Datenbank aufbauen ----
 
   DBName = "D:\Sicherung_SQL\" & Format(Date, "DDDD") & ".mdb"
   Dim WebDB As Database, WebSet As Recordset
   If Dir(DBName) <> "" Then Kill DBName
   Set WebDB = Workspaces(0).CreateDatabase(DBName, dbLangGeneral)
 
   '---- Erstellern der Table ----
   ProgressBar1.Max = UBound(Table) - 1
   For T = 0 To UBound(Table) - 1
      Label1.Caption = "Erstellen der Tabellen für die Sicherung (" & Table(T) _
        & ")"
      ProgressBar1.Value = T
      DoEvents
 
      If InStr(Table(T), ".") > 0 Then TS = "select " & Table(T) Else TS = _
        "select * from " & Table(T)
      Set WebSQLSet = WebSQLCon.OpenRecordset(TS, dbOpenDynaset)
      If InStr(Table(T), ".") > 0 Then TS = Left(Table(T), InStr(Table(T), _
        ".") - 1) Else TS = Table(T)
      Set tdfNew = WebDB.CreateTableDef(TS)
 
      For F = 0 To WebSQLSet.Fields.Count - 1
         If WebSQLSet.Fields(F).Type = 23 Then
            tdfNew.Fields.Append tdfNew.CreateField(WebSQLSet.Fields(F).Name, _
              dbDate)
         ElseIf WebSQLSet.Fields(F).Type = 20 Then
            tdfNew.Fields.Append tdfNew.CreateField(WebSQLSet.Fields(F).Name, _
              dbCurrency)
         ElseIf WebSQLSet.Fields(F).Type = 10 Then
            If WebSQLSet.Fields(F).Size > 255 Then
               Set fldTemp = tdfNew.CreateField(WebSQLSet.Fields(F).Name, _
                 dbMemo)
                 fldTemp.AllowZeroLength = WebSQLSet.Fields(F).AllowZeroLength
               tdfNew.Fields.Append fldTemp
            Else
               Set fldTemp = tdfNew.CreateField(WebSQLSet.Fields(F).Name, _
                 dbText)
                 fldTemp.AllowZeroLength = WebSQLSet.Fields(F).AllowZeroLength
                 fldTemp.Size = WebSQLSet.Fields(F).Size
               tdfNew.Fields.Append fldTemp
            End If
         Else
            tdfNew.Fields.Append tdfNew.CreateField(WebSQLSet.Fields(F).Name, _
              WebSQLSet.Fields(F).Type)
         End If
      Next
      If TS = "UFP_SoPr" Then
         Set idxNew = tdfNew.CreateIndex("KundeNrShopNrPrkode")
         With idxNew
            .Fields.Append .CreateField("KundeNr")
            .Fields.Append .CreateField("ShopNR")
            .Fields.Append .CreateField("PRKODE")
            .Primary = True
         End With
         tdfNew.Indexes.Append idxNew
      End If
      WebDB.TableDefs.Append tdfNew
   Next T
 
 
   '---- Download der Daten -----
   For T = 0 To UBound(Table) - 1
      Label1.Caption = "Download der Tabelle '" & Table(T) & "'"
      ProgressBar1.Value = T
      DoEvents
      Set WebSQLSet = WebSQLCon.OpenRecordset("Select * from " & Table(T), _
        dbOpenDynaset)
      Set WebSet = WebDB.OpenRecordset(Table(T), dbOpenDynaset)
      Do Until WebSQLSet.EOF
         WebSet.AddNew
         For F = 0 To WebSQLSet.Fields.Count - 1
            WebSet.Fields(F).Value = WebSQLSet.Fields(F).Value
         Next F
         WebSet.Update
         WebSQLSet.MoveNext
         DoEvents
      Loop
   Next T
 
   WebDB.Close
   WebSQLCon.Close
   Set wrkODBC = Nothing
 
   End