Archiving part of database from VB6

[Afi83]

Hi there

I have a database in access for using from VB6. In my access file I use many relationships. I use something for doing back up of my database frequently for preventing data loss. Every year many data added to this database (app50000). For maintaining the program at the best performance I want to archive the older data.
What I have to do?
I want to add the power of using these archived files in later. Then when user want to use data from 2008 can be accessed through application.

Can anyone get me to the right path?

Thanks in advance

[debasisdas]

Try this sample code for taking backup and restore of access database

Dim DBTempSource As Database
Dim DBTempDestination As Database

Dim RecTempSource As Recordset
Dim RecTempDestination As Recordset

Sub MBackup()

Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Errors
If OptBackup Then
    TxtRemarks = "Backup Started at " & Time
    TxtRemarks = TxtRemarks & vbCrLf & "Closing Connection ...!"
    GCnnGeneral.Close
    TxtRemarks = TxtRemarks & vbCrLf & "Checking Destination ...!"
    If GFileExists(TxtDestination) Then
        Kill TxtDestination
    End If
    
    TxtRemarks = TxtRemarks & vbCrLf & "Compacting Source ..."
    DBEngine.CompactDatabase TxtSource, TxtDestination, , , ";pwd=Debasis"
    TxtRemarks = TxtRemarks & vbCrLf & "Destination Created ...!"
    TxtRemarks = TxtRemarks & vbCrLf & "Connecting Database ...!"
    With GCnnGeneral
       .Provider = "Microsoft.Jet.OLEDB.4.0"
       .Properties("Jet OLEDB:Database Password") = "Debasis"
       .Mode = adModeReadWrite
       .Open App.Path & "\" & Trim(GFileName) & ".MDB"
    End With
    'GFileName = Trim(LstDatabase.Text)
    TxtRemarks = TxtRemarks & vbCrLf & "Backup Created at " & Time
    MsgBox "Backup Created."
    TxtSource = GEmptyStr
    TxtDestination = GEmptyStr
ElseIf OptRestore Then
    'GCnnAccts.Close
    TxtRemarks = "Restoring Data Started at " & Time
    GCnnGeneral.Close
    TxtRemarks = TxtRemarks & vbCrLf & "Connection Closed ...!"
    Kill TxtDestination
    TxtRemarks = TxtRemarks & vbCrLf & "Destination Checked ...!"
    Call FSO.CopyFile(TxtSource, TxtDestination, True)
    TxtRemarks = TxtRemarks & vbCrLf & "Data Restored ...!"
    With GCnnGeneral
       .Provider = "Microsoft.Jet.OLEDB.4.0"
       .Properties("Jet OLEDB:Database Password") = "Debasis"
       .Mode = adModeReadWrite
       .Open App.Path & "\" & Trim(GFileName) & ".MDB"
    End With
    TxtRemarks = TxtRemarks & vbCrLf & "Connection Complete ...!"
    TxtRemarks = TxtRemarks & vbCrLf & "Data Restored at " & Time
    MsgBox "Data Restored."
End If

Exit Sub
Errors:
    MsgBox "[ErrNo.: " & Err.Number & "] " & Err.Description
End Sub

Private Sub CmdBackup_Click()
If Trim(TxtSource) = GEmptyStr Then
    MsgBox "Source Filename Empty."
    Exit Sub
End If

If Trim(TxtDestination) = GEmptyStr Then
    MsgBox "Destination Filename Empty."
    Exit Sub
End If

If OptBackup Then
    If Not GFileExists(TxtSource) Then
        MsgBox "Source File Does Not Exist! Please Contact Program Vendor."
        Exit Sub
    End If
    If GFileExists(TxtDestination) Then
        If MsgBox("Destination File Already Exists! Do you Want to Replace the File?", vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        End If
    End If
ElseIf OptRestore Then
    If Not GFileExists(TxtSource) Then
        MsgBox "Source File Does Not Exist! Check Filename and Path."
        Exit Sub
    End If
End If
Call MBackup
End Sub

Private Sub CmdDestinationSearch_Click()
If OptBackup Then
    CDOpen.DefaultExt = "Bak"
    CDOpen.FileName = "Temp.Bak"
    CDOpen.ShowSave
    TxtDestination = CDOpen.FileName
Else
    TxtDestination = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")  'GFileName
End If
End Sub

Private Sub CmdExit_Click()
Unload Me
End Sub

Private Sub CmdSourceSearch_Click()
If OptBackup Then
    TxtSource = Replace(App.Path & "\" & Trim(GFileName) & ".MDB", "\\", "\")    'GFileName
Else
    CDOpen.DefaultExt = "Bak"
    CDOpen.FileName = "Temp.Bak"
    CDOpen.ShowOpen
    TxtSource = CDOpen.FileName
End If
End Sub

Private Sub Form_Resize()
Me.Left = (FrmBackground.Width - Me.Width) / 2
Me.Top = (FrmBackground.Height - Me.Height) / 2
End Sub

Private Sub OptAll_Click()
FraPart.Visible = False
End Sub

Private Sub OptBackup_Click()
CmdBackup.Caption = OptBackup.Caption & " &File"
TxtRemarks = GEmptyStr
End Sub

Private Sub OptPart_Click()
FraPart.Visible = True
DtpFrom = Format(DateAdd("d", 7, GTransactDate), "dd/MMM/yyyy")
DtpTo = Format(GTransactDate, "dd/MMM/yyyy")
End Sub

Private Sub OptRestore_Click()
CmdBackup.Caption = OptRestore.Caption & " &File"
TxtRemarks = GEmptyStr
End Sub

NOTE:--Users can customize the above code by adding / altering / removing the name of the controls and other parts of the code.

[Afi83]

Thanks for really useful backup proc. But what about archiving part of database in another file.

[omoridi]

you can copy all of the database in some folder like 2005,2006,2007,2008 and
remove old value in current database.
after that in ur program write choose cycle and show the folders was u created.