Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
|
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old October 11th, 2006, 08:46 AM
Authorized User
 
Join Date: Oct 2006
Posts: 12
Thanks: 0
Thanked 0 Times in 0 Posts
Default Backing up an MS Access Database

I have a database with the back-end on the server and the front-end on the individual users hard drive with the tables in the front-end directly linked to the tables in the back-end. I need to write some code to automatically back-up the back-end on the server to a file on the user's hard drive every 2 or 3 hours. As of right now the only way I know to do that through VBA code is by using the transfer database code on all the tables in the back-end to an mdb file on the hard drive. Is there any back-up database code in VBA or a better approach to this problem?

thanks in advance
donrafeal7

 
Old October 11th, 2006, 11:05 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 1,093
Thanks: 1
Thanked 12 Times in 11 Posts
Default

Hello,

Since "backing up" an Access DB amounts to nothing more than making a simple file copy, just use the FileCopy statement, something like:

Code:
Private Sub cmdBackup_Click()

    On Error GoTo Errorhandler

    If IsNull(Me.txtFileBackUp) Then
        MsgBox ("No source file selected")
        Exit Sub
    End If

    If IsNull(Me.txtFileBackupDestination) Then
        MsgBox ("No destination directory selected")
        Exit Sub
    End If

    If Me.txtFileBackUp = Me.txtFileBackupDestination Then
        MsgBox ("You cannot backup to the same file.")
        Exit Sub
    End If

    If Not FileExists(Me.txtFileBackUp) Then
        MsgBox ("Source file does not exist")
        Exit Sub
    End If

    If FileExists(Me.txtFileBackupDestination) Then
        If MsgBox("Destination file exists, do you want to overwrite?", vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If

    DoCmd.Hourglass True
    FileCopy Me.txtFileBackUp, Me.txtFileBackupDestination
    DoCmd.Hourglass False
    If FileExists(Me.txtFileBackupDestination) Then
        MsgBox ("File successfully backed up")
    End If

    Exit Sub
Errorhandler:
    MsgBox Err.Description
    DoCmd.Hourglass False

End Sub

Function FileExists(strFile As String) As Boolean
    Dim i As Integer
 
    On Error Resume Next
    i = Len(Dir(strFile))
    FileExists = (Not Err And i > 0)

End Function
Generally its nice to allow users to browse for the Source File and the Destination Directory. You can use the Windows Open File dialog (the FileSelInfo object) and some API calls to do that. For example, the txtFileBackUp (the Source File) and txtFileBackupDestination (the Destination Directory) get populated using the click event of two command buttons.

Code:
Private Sub cmdOpenBackup_Click()
    On Error GoTo Errorhandler
    Me.txtFileBackUp = OpenFile(Me.txtFileBackUp)
    Exit Sub
Errorhandler:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"

End Sub

Private Sub cmdOpenDestination_Click()
    On Error GoTo Errorhandler
    Me.txtFileBackupDestination = SelectDir("", , , "Select destination for backup")

    If Not IsNull(Me.txtFileBackUp) Then
        Me.txtFileBackupDestination = Me.txtFileBackupDestination & "\" & GetNamePart(Me.txtFileBackUp)
    End If
    Exit Sub
Errorhandler:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"

End Sub

Function GetNamePart(strIn As String) As String
Dim i As Integer
Dim strTmp As String
    For i = Len(strIn) To 1 Step -1
        If Mid$(strIn, i, 1) <> "\" Then
            strTmp = Mid$(strIn, i, 1) & strTmp
        Else
            Exit For
        End If
    Next i
    GetNamePart = strTmp

End Function
The OpenFile and SelectDir methods are API calls defined in the following modlue:

Code:
Option Compare Database
Option Explicit

Type FileSelInfo
    hwndOwner As Long
    strApp As String * 255
    strTitle As String * 255
    strButton As String * 255
    strFile As String * 4096
    strDir As String * 255
    strFilter As String * 255
    lngIndex As Long
    lngView As Long
    lngFlags As Long
End Type

Declare Function GetFileInfo Lib "msaccess.exe" Alias "#56" _
    (FSI As FileSelInfo, ByVal fOpen As Integer) As Long

Function OpenFile(Optional strFile As Variant = Null, _
    Optional strFilter As String = "All Files (*.*)", _
    Optional strDir As String = "", _
    Optional strTitle As String = "", _
    Optional strButton As String = "")
'Use to choose a file to open
Dim FSI As FileSelInfo

    On Error GoTo Errorhandler
    With FSI
        .lngFlags = 0
        .strFilter = RTrim(strFilter) & vbNullChar
        .lngIndex = CInt("0")
        If Not IsNull(strFile) Then
            .strFile = RTrim(strFile) & vbNullChar
        End If
        .strTitle = RTrim(strTitle) & vbNullChar
        .strButton = RTrim(strButton) & vbNullChar
        .strDir = RTrim(strDir) & vbNullChar
    End With

    If GetFileInfo(FSI, True) = 0 Then OpenFile = TrimNull(FSI.strFile)
    GoTo Done

Errorhandler:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
Done:
End Function

Private Function TrimNull(str As String) As String
Dim i As Integer
    TrimNull = str
    i = InStr(str, vbNullChar)
    If i > 0 Then TrimNull = Left(str, i - 1)
    TrimNull = (RTrim(TrimNull))
End Function

Function SelectDir(Optional strFile As Variant = Null, _
    Optional strFilter As String = "", _
    Optional strDir As String = "", _
    Optional strTitle As String = "", _
    Optional strButton As String = "")
'Use to choose a directory
Dim FSI As FileSelInfo

    On Error GoTo Errorhandler
    With FSI
        .lngFlags = &H20
        .strFilter = RTrim(strFilter) & vbNullChar
        .lngIndex = CInt("0")
        If Not IsNull(strFile) Then
            .strFile = RTrim(strFile) & vbNullChar
        End If
        .strTitle = RTrim(strTitle) & vbNullChar
        .strButton = RTrim(strButton) & vbNullChar
        .strDir = RTrim(strDir) & vbNullChar
    End With

    If GetFileInfo(FSI, True) = 0 Then SelectDir = TrimNull(FSI.strFile)
    Exit Function

Errorhandler:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"

End Function
HTH,

Bob

 
Old October 11th, 2006, 11:33 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 1,093
Thanks: 1
Thanked 12 Times in 11 Posts
Default

Hmm...never mind the API stuff I guess. I see you want your backup to happen automatically. You could run the FileCopy routine on a timer event, but that would require forcing users out of their apps to perform the backup (just don't know if thats necessary using Transfer Database, never tried it). The mdb. file has to be closed though to use FileCopy.






Similar Threads
Thread Thread Starter Forum Replies Last Post
Database migration MS Access 2003 to MS SQL 2000 ayazhoda SQL Server 2000 3 April 23rd, 2007 11:38 AM
Backing up a database BigH140 Access 9 August 8th, 2006 09:09 AM
Access issues with ASP and a MS Access Database rj_conceptsnrec.com Classic ASP Databases 2 May 19th, 2005 12:44 PM
How to connect to an MS Access database? petercahyadi Java Databases 3 February 22nd, 2005 07:28 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.