Copying a Table

[ptrifile]

I have been experiencing some data corruption and would like to know if its possible without using additional software to automatically make a copy of a table and save it somewhere or to another access database on a daily or nightly basis? Any help is appreciated.

Thanks

Paul

 

[Nordyck]

Paul,

The simplist way would to create your backup mdb with code that when it's open, it automatically pulls the data from the other database. Use the task scheduler, to start the mdb at specified time. This will do your daily backups.

Don't forget to compact on close. Otherwise the mdb will keep on growing.

nordycki@hotmail.com

 

[Wantabie]

Try this:

Public Function CopyTable()
    Dim db As Database
    Dim rsto As Recordset
    Dim rstn As Recordset
    Dim stroTable As String
    Dim strnTable As String
    Dim RecCount As Long
    Dim varBookmark As Variant
    
    On Error GoTo ErrHandler
    
    [COLOR=green]'Get the name of the table[/color]
    stroTable = InputBox("Enter in the old table: ", "Old Table...")
    [COLOR=green]'Get the name of the new table[color]
    strnTable = InputBox("Enter in the new table: ", "New Table...")
    
    If fExistTable("" & strnTable & "") = False Then [COLOR=green]'Check for table existance[/color]
    [COLOR=green]'If table does not exist, create one using the same structure as the table you want to copy[/color]
        sCopyTableStructure "" & stroTable & "", "" & strnTable & ""
    End If
    
    [COLOR=green]'Open the tables recordset[/color]
    Set db = CurrentDb()
    Set rsto = db.OpenRecordset("" & stroTable & "")
    Set rstn = db.OpenRecordset("" & strnTable & "")
    
    RecCount = 0
    rsto.MoveLast
    rsto.MoveFirst
    
    Do While Not rsto.EOF
        varBookmark = rsto.Bookmark
        rstn.AddNew
        [COLOR=green]'Copy Data for each field to the table[/color]
        For RecCount = 0 To rstn.Fields.Count - 1
            rstn.Fields(RecCount).Value = rsto.Fields(rstn.Fields(RecCount).Name).Value
        Next
        
        [COLOR=green]'Continue copying all rows from old table to new table[/color]
        rstn.Update
        RecCount = RecCount + 1
        DoEvents
            If RecCount Mod 10 = 0 Then
                MsgBox RecCount [COLOR=green]'Show progress every 10 rows[/color]
            End If
            If RecCount = 50 Then
                Exit Function
            End If
        rsto.MoveNext
    Loop
    MsgBox RecCount [COLOR=green]'Show total successful record count[/color]
    rsto.Close
    rstn.Close
    db.Close
    
ExitLine:
    Exit Function
ErrHandler:
    MsgBox "Error: " & Error$
    Resume ExitLine
End Function

[COLOR=green]'---------------------------------------------------------------------------------------[/color]
Public Function sCopyTableStructure(strOldTableName As String, strNewTableName As String)
    If vbYes = MsgBox("Are you sure?", vbYesNo + vbDefaultButton2 + vbExclamation, "Create New Table ") Then
        DoCmd.TransferDatabase acImport, "Microsoft Access", CurrentDb.Name, acTable, strOldTableName, strNewTableName, True
    End If
End Function

[COLOR=green]'---------------------------------------------------------------------------------------[/color]
Public Function fExistTable(strTableName As String) As Integer
Dim db As Database
Dim i As Integer
    Set db = DBEngine.Workspaces(0).Databases(0)
    fExistTable = False
    db.TableDefs.Refresh
    For i = 0 To db.TableDefs.Count - 1
        If strTableName = db.TableDefs(i).Name Then
            'Table Exists
            fExistTable = True
            Exit For
        End If
    Next i
    Set db = Nothing
End Function

Let me know if this works out for you

Wantabie