Backing up an Access datatabase 2

[maxflitom]

Dear Tek-Tips:

I would like to add code to backup an Access database from within my VB6 application. I don't just want to use FileCopy, I want to be able to span it over several disks if necessary and then code a Restore menu option to restore the backup if necessary.

Any suggestions are greatly appreciated.

Tom (maxflitom)

 

[wraygun]

I found this snippet on another site awhile back and have used it successfully. You'll have to adapt it to your needs. Hope it helps

Project: Standard EXE

Controls: txtFile (Textbox), txtSize (Textbox), txt (Textbox, MultiLine set to True), cmb (ComboBox), lblOut (Label), cmdBrowse (Command button), cmdSplit (Command button), cmdMerge (Command button), dlg (CommonDialog Control)

Code:

Dim nLen As Double
Dim strFName As String
Dim b() As Byte

Private Sub cmdBrowse_Click()
    dlg.ShowOpen
    txtFile = dlg.FileName
    strFName = dlg.FileTitle
End Sub

Private Sub cmdMerge_Click() ' merge previously splitted file to its split direcory
    Dim n As Double: Dim i As Long: Dim bOpen As Boolean: Dim d As Double

    For i = 0 To File1.ListCount - 1
        If IsNumeric(Right(File1.List(i), 3)) Then
            If Not bOpen Then
                Open lblOut & "\" & Left(File1.List(i), Len(File1.List(i)) - 4) For Binary As 2
                bOpen = True
            End If
            n = FileLen(lblOut & "\" & File1.List(i))
            Open lblOut & "\" & File1.List(i) For Binary As 1
            ReDim b(n - 1)
            Get #1, , b()
            Put #2, d + 1, b()
            Close #1
            d = d + n
        End If
    Next
    Close #2
    File1.Refresh
End Sub

Private Sub cmdSplit_Click() 'split file on two equal files
    If Trim(txtFile) = "" Or Dir(txtFile) = "" Then
        MsgBox "File doesn't exist"
        cmdBrowse.SetFocus
        Exit Sub
    End If
    If Val(txtSize) < 1 Then
        MsgBox &quot;Incorrect split size&quot;
        txtSize.SetFocus
        Exit Sub
    End If
    On Error GoTo er1
    lblOut = txtFile & &quot;_split&quot;
    lblOut.Refresh
    MkDir lblOut
    File1.Path = lblOut
    File1.Visible = True
    txt.Visible = False
    If cmb.ListIndex = -1 Then cmb.ListIndex = 2
    Dim i As Long 'number of file
    Dim ss As Double 'split size
    If cmb.ListIndex = 0 Then
        ss = 1024
        ss = ss * 1024
    ElseIf cmb.ListIndex = 1 Then
        ss = 1024
    Else
        ss = 1
    End If
    ss = Round(Val(txtSize) * ss, 0)
    nLen = FileLen(txtFile)
    Open txtFile For Binary As 1
    While nLen > ss
        ReDim b(ss - 1)
        Get #1, ss * i + 1, b()
        Open lblOut & &quot;\&quot; & strFName & &quot;.&quot; & Format(i, &quot;000&quot;) For Binary As 2
        Put #2, , b()
        Close #2
        File1.Refresh
        i = i + 1
        nLen = nLen - ss
    Wend
    ReDim b(nLen - 1)
    Get #1, ss * i + 1, b()
    Open lblOut & &quot;\&quot; & strFName & &quot;.&quot; & Format(i, &quot;000&quot;) For Binary As 2
    Put #2, , b()
    Close #2
    File1.Refresh
    Beep
    Close #1
    Exit Sub
er1:
    Select Case Err
    Case 75
        If MsgBox(&quot;Split folder already exist. Would you like to overwrite it?&quot;, vbYesNo) = vbYes Then
            Dim j As Long
            File1.Path = lblOut
            For j = File1.ListCount - 1 To 0 Step -1
                Kill lblOut & &quot;\&quot; & File1.List(j)
            Next
            RmDir lblOut
            Resume
        Else
            lblOut = &quot;Output Directory&quot;
        End If
    Case Else
        MsgBox Err.Number & &quot;: &quot; & Err.Description
    End Select
End Sub

Private Sub Form_Load()
    cmb.ListIndex = 0
    File1.Visible = False
End Sub

***You can't change your past, but you can change your future***

 

[vbSun]

Another way too do the backup.
Just change the sSource and sDestination arguments to something that suites your needs.

Public Function CompactAndRepairDB(sSource As String, _
sDestination As String, _
Optional sSecurity As String, _
Optional sUser As String = "Admin", _
Optional sPassword As String, _
Optional lDestinationVersion As Long) As Boolean

On Error GoTo errhand
Dim sCompactPart1 As String
Dim sCompactPart2 As String
Dim oJet As JRO.JetEngine

' Put together the provider string for the source database
sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
";Data Source=" & sSource & _
";User Id=" & sUser & _
";Password=" & sPassword

' If the database has a user-level security file, add the
' details
If sSecurity <> &quot;&quot; Then
sCompactPart1 = sCompactPart1 & _
&quot;;Jet OLEDB:System database=&quot; & sSecurity & &quot;;&quot;
End If

' Put together the provider string for the destination
' database
sCompactPart2 = &quot;Provider=Microsoft.Jet.OLEDB.4.0&quot; & _
&quot;;Data Source=&quot; & sDestination

' The destination database will end up in the latest version
' of jet, unless a specific version has been requested;
' 1 = Jet 1.0, 2 = Jet 1.1, 3 = Jet 2.x, 4 = Jet 3.x,
' 5 = Jet 4.x etc
If lDestinationVersion <> 0 Then
sCompactPart2 = sCompactPart2 & _
&quot;;Jet OLEDB:Engine Type=&quot; & lDestinationVersion
End If

' Compact and repair the database
Set oJet = New JRO.JetEngine
oJet.CompactDatabase sCompactPart1, sCompactPart2
Set oJet = Nothing

CompactAndRepairDB = True

Exit Function

errhand:
Screen.MousePointer = vbDefault
CompactAndRepairDB = False
MsgBox Err.Description, vbCritical

End Function


This function uses the Microsoft Jet and Replication Objects Library (part of ADO) to compact and repair a Microsoft Access database. You can also use this function to copy a database file to the path specified in the sDestination. It also compacts and repairs the DB before copying it.

 

[maxflitom]

Thanks wraygun and vbSun! I gave both of you a star. I will try out both snippits!!

Thanks Again!!!!!!!

Tom (maxflitom)

 

[terry22]

Hi A little additional info on this post:
A reference needs to be added to the project:
' DESCRIPTION:
' This function uses the Microsoft Jet and Replication Objects
' Library (part of ADO) to compact and repair a Microsoft Access
' database. A project reference is required to the Microsoft Jet
' and Replication Objects Library.
'
' You may want to add error handling to this procedure, or to
' the function that calls it as the compact and repair may fail,
' for instance, if exclusive access cannot be gained to the
' source database.