VBA code for button to back-up DB

  • Thread starter Thread starter Neil Greenough
  • Start date Start date
N

Neil Greenough

I have a split-end database and have a button on my switchboard. Now, when
this button is pressed, I would like my back-up database to be updated. The
back-up database is called "SpecBackUp."

Any ideas what code I should put behind the button? I am new to VBA and so
would appreciate full code.

Thanks
 
Basically, I have a front end and back end database. Now, just in case the
back end gets a virus or just decided to crash, at the end of the week, I
will copy all the info from the back end database into a second backend
database if you like (hence, a back-up). By 'updated', I mean all new info
will be copied from the current backend to the backup backend.

Hope that makes a little more sense.
 
Why not just make a copy of the backend file "as is", and keep that as a
backup? Much easier than writing data into the backup file.
 
That's what I essentially want to do. I just want to do it from a button on
my switchboard though. So, essentially, when the button is pressed, the
backend is copied, names "SpecBackUp" and then places in C:/

Is there a way of doing this with a code behind a button?
 
I think the right way is to define some task in windows that create a
directory and copy the DB to that directory.
if you cant find a solution, then mybe you can use that code:

' Make a directory to save the file to, better has date and time
dim MyDateStr as string
MyDateStr = format(now,"yyyymmddhhmm")
MkDir "c:\BackUp\" & MyDateStr
' copy the mdb to that directory
shell ("xcopy c:\MyDB.mdb c:\backup\" & MyDateStr )
 
Yes, though you should first have the front end close all its connections to
the back end file so that the locking file (the .ldb file) is deleted and
won't cause any grief. It is possible to copy a backend file while there is
a locking file present, but you would not know if any data are being written
to the database at the time that you make the copy. Of course, it completely
depends upon the situation that exists when you would run the code.

Here is some code that I've pulled from one of my applications. I took out a
few things that are specific to that application, so it's possible that you
may get a compiler error the first time. Let me know if you need assistance
with this.
---------------------------

' ****************************************
' ** Subroutine UserCreateBackendBackup **
' ****************************************

Public Sub UserCreateBackendBackup()
' *** THIS SUBROUTINE IS USED TO ALLOW A USER TO CREATE A BACKUP COPY OF
' *** THE BACKEND DATABASE FILE IN ANOTHER LOCATION (e.g., ZIP DISC DRIVE,
' *** CD DRIVE, NETWORK LOCATION, etc.)
' Ken Snell 19 May 2005

Dim dbs_DB As DAO.Database
Dim datNowValue As Date
Dim xstrToLocation As String, strTempVar As String, strPathOfBE As String
Dim strPathFilenameOfBE As String, strFilenameOfBE As String
Dim tdf_DB As DAO.TableDef

On Error GoTo Err_CopyBackup

DoCmd.Hourglass True


Set dbs_DB = CurrentDb

' Get the path and filename of the "backend" file
For Each tdf_DB In dbs_DB.TableDefs
If Len(tdf_DB.Connect & "") > 0 Then
strPathFilenameOfBE = Replace(tdf_DB.Connect, ";DATABASE=", _
"", 1, -1, vbTextCompare)
Exit For
End If
Next tdf_DB
Set tdf_DB = Nothing
DoEvents
strFilenameOfBE = ExtractFileName(strPathFilenameOfBE)
strPathOfBE = ExtractPath(strPathFilenameOfBE)

' Check to see if an .ldb file exists for the current backend file. If yes,
tell user
' that someone is in the backend, and the copy cannot be created; then
reopen form
' "_frm_KeepRecordsetOpen" in *hidden* mode and exit the subroutine.
strTempVar = Dir(Left(strPathFilenameOfBE, _
Len(strPathFilenameOfBE) - 3) & strLockFileExtension)

If strTempVar <> "" Then

MsgBox "Someone else is still working in the CADELL POS database! The
program " & _
"cannot make a copy of the ""backend"" file at this time." & _
vbCrLf & vbCrLf & "Try again later when no one other than you is
working " & _
"in the database.", vbCritical, "Cannot Copy Backend File!"


Else

' Provide the directory to the folder where the copy is to be put
xstrToLocation = "PathToWhereToPutTheBackendFile"

On Error Resume Next

If xstrToLocation <> "" Then

datNowValue = Now
' Copy the backend file to the selected location
FileCopy strPathFilenameOfBE, xstrToLocation & strFilenameOfBE

If Err.Number = 75 Then
MsgBox "You cannot create a file in the folder that you
selected:" & _
vbCrLf & Space(5) & """" & xstrToLocation & """" & vbCrLf &
vbCrLf & _
"The device may be a ""read-only"" device, or you may not
have " & _
"permission to write to the folder." & vbCrLf & vbCrLf & _
"Select a different location.", vbCritical, "Cannot Create
File"
Err.Clear
GoTo LoopLabel

Else

Open strPathOfBE & "Backend_Manually_Copied_On_" & _
Format(datNowValue, "ddmmmyyyy_hh.nn.ssAMPM") & ".txt" For
Output As #1
Print #1, "A copy of the backend database file ( """ &
strPathFilenameOfBE & _
""" ) was manually created by the front end's backup
feature:"
Print #1, " -- made on " & Format(datNowValue, "mmmm
dd, yyyy") & _
" at " & Format(datNowValue, "hh:nn:ss AMPM")
Print #1, " -- copied to """ & xstrToLocation &
strFilenameOfBE & """"
Print #1, " -- copied by """ & fOSUserName & """ from
computer """ & _
fOSMachineName & """"
Close #1
DoEvents
' Tell user that the copying was successful
MsgBox "The file has been created at" & vbCrLf & Space(5) &
xstrToLocation & _
strFilenameOfBE, vbInformation, "File Created"

End If

Else

MsgBox "No location was selected. No copy of the backend file will
be made.", _
vbExclamation, "No Location Selected"

End If

End If

Exit_CopyBackup:
On Error Resume Next
Set tdf_DB = Nothing
dbs_DB.Close
Set dbs_DB = Nothing
DoCmd.Hourglass False
Err.Clear
Exit Sub

Err_CopyBackup:
If Err.Number = 71 Then
MsgBox "The device that you selected ( """ & xstrToLocation & _
""" ) does not contain a disc or diskette. " & _
"The file cannot be copied to this device.", vbCritical, _
"No Disc or Diskette"
Else
MsgBox "An error has occurred while making a copy of the backend
database file:" & _
vbCrLf & " Error #" & Err.Number & ": " & Err.Description & vbCrLf
& vbCrLf & _
"Try again in a few minutes. If the problem persists, contact the
programmer for assistance.", _
vbCritical, "Error While Copying File"
End If
Resume Exit_CopyBackup

End Sub

' ********************************
' ** Function ExtractFileName **
' ********************************

Public Function ExtractFileName(ByVal strPathFile As String) As String
' *** THIS FUNCTION EXTRACTS THE "FILE NAME" PORTION OF A STRING THAT HOLDS
' *** THE FULL PATH AND FILENAME FOR A FILE. IT DOES THIS BY DROPPING
' *** THE PATH PORTION FROM THE STRING (ALL TEXT BEFORE THE LAST
' *** "\" CHARACTER IN THE STRING, AND THAT LAST "\" CHARACTER, TOO).

' *** IF THERE IS NO "\" CHARACTER IN THE TEXT STRING, THE FUNCTION RETURNS
' *** AN EMPTY STRING AS ITS VALUE. OTHERWISE, IT RETURNS THE "FILE NAME"
PORTION
' *** OF THE TEXT STRING.
' Ken Snell 19 May 2005

' strPathFile is string variable that contains the full path and filename
text string.

On Error Resume Next

If InStr(strPathFile, "\") = 0 Then
ExtractFileName = ""
Else
ExtractFileName = Mid(strPathFile, InStrRev(strPathFile, "\") + 1)
End If
Err.Clear
End Function




' ****************************
' ** Function ExtractPath **
' ****************************

Public Function ExtractPath(ByVal strPathFile As String) As String
' *** THIS FUNCTION EXTRACTS THE "PATH" PORTION OF A STRING THAT HOLDS
' *** THE FULL PATH AND FILENAME FOR A FILE. IT DOES THIS BY DROPPING
' *** THE FILENAME PORTION FROM THE STRING (ALL TEXT AFTER THE LAST
' *** "\" CHARACTER IN THE STRING).

' *** IF THERE IS NO "\" CHARACTER IN THE TEXT STRING, THE FUNCTION RETURNS
' *** AN EMPTY STRING AS ITS VALUE. OTHERWISE, IT RETURNS THE "PATH" PORTION
' *** (INCLUDING THE ENDING "\" CHARACTER) OF THE TEXT STRING.
' Ken Snell 19 May 2005

' strPathFile is string variable that contains the full path and filename
text string.

On Error Resume Next

If InStr(strPathFile, "\") = 0 Then
ExtractPath = ""
Else
ExtractPath = Left(strPathFile, InStrRev(strPathFile, "\"))
End If
Err.Clear
End Function
 
Thanks Ken

Ken Snell said:
Yes, though you should first have the front end close all its connections
to the back end file so that the locking file (the .ldb file) is deleted
and won't cause any grief. It is possible to copy a backend file while
there is a locking file present, but you would not know if any data are
being written to the database at the time that you make the copy. Of
course, it completely depends upon the situation that exists when you
would run the code.

Here is some code that I've pulled from one of my applications. I took out
a few things that are specific to that application, so it's possible that
you may get a compiler error the first time. Let me know if you need
assistance with this.
---------------------------

' ****************************************
' ** Subroutine UserCreateBackendBackup **
' ****************************************

Public Sub UserCreateBackendBackup()
' *** THIS SUBROUTINE IS USED TO ALLOW A USER TO CREATE A BACKUP COPY OF
' *** THE BACKEND DATABASE FILE IN ANOTHER LOCATION (e.g., ZIP DISC DRIVE,
' *** CD DRIVE, NETWORK LOCATION, etc.)
' Ken Snell 19 May 2005

Dim dbs_DB As DAO.Database
Dim datNowValue As Date
Dim xstrToLocation As String, strTempVar As String, strPathOfBE As String
Dim strPathFilenameOfBE As String, strFilenameOfBE As String
Dim tdf_DB As DAO.TableDef

On Error GoTo Err_CopyBackup

DoCmd.Hourglass True


Set dbs_DB = CurrentDb

' Get the path and filename of the "backend" file
For Each tdf_DB In dbs_DB.TableDefs
If Len(tdf_DB.Connect & "") > 0 Then
strPathFilenameOfBE = Replace(tdf_DB.Connect, ";DATABASE=", _
"", 1, -1, vbTextCompare)
Exit For
End If
Next tdf_DB
Set tdf_DB = Nothing
DoEvents
strFilenameOfBE = ExtractFileName(strPathFilenameOfBE)
strPathOfBE = ExtractPath(strPathFilenameOfBE)

' Check to see if an .ldb file exists for the current backend file. If
yes, tell user
' that someone is in the backend, and the copy cannot be created; then
reopen form
' "_frm_KeepRecordsetOpen" in *hidden* mode and exit the subroutine.
strTempVar = Dir(Left(strPathFilenameOfBE, _
Len(strPathFilenameOfBE) - 3) & strLockFileExtension)

If strTempVar <> "" Then

MsgBox "Someone else is still working in the CADELL POS database! The
program " & _
"cannot make a copy of the ""backend"" file at this time." & _
vbCrLf & vbCrLf & "Try again later when no one other than you is
working " & _
"in the database.", vbCritical, "Cannot Copy Backend File!"


Else

' Provide the directory to the folder where the copy is to be put
xstrToLocation = "PathToWhereToPutTheBackendFile"

On Error Resume Next

If xstrToLocation <> "" Then

datNowValue = Now
' Copy the backend file to the selected location
FileCopy strPathFilenameOfBE, xstrToLocation & strFilenameOfBE

If Err.Number = 75 Then
MsgBox "You cannot create a file in the folder that you
selected:" & _
vbCrLf & Space(5) & """" & xstrToLocation & """" & vbCrLf &
vbCrLf & _
"The device may be a ""read-only"" device, or you may not
have " & _
"permission to write to the folder." & vbCrLf & vbCrLf & _
"Select a different location.", vbCritical, "Cannot Create
File"
Err.Clear
GoTo LoopLabel

Else

Open strPathOfBE & "Backend_Manually_Copied_On_" & _
Format(datNowValue, "ddmmmyyyy_hh.nn.ssAMPM") & ".txt" For
Output As #1
Print #1, "A copy of the backend database file ( """ &
strPathFilenameOfBE & _
""" ) was manually created by the front end's backup
feature:"
Print #1, " -- made on " & Format(datNowValue, "mmmm
dd, yyyy") & _
" at " & Format(datNowValue, "hh:nn:ss AMPM")
Print #1, " -- copied to """ & xstrToLocation &
strFilenameOfBE & """"
Print #1, " -- copied by """ & fOSUserName & """ from
computer """ & _
fOSMachineName & """"
Close #1
DoEvents
' Tell user that the copying was successful
MsgBox "The file has been created at" & vbCrLf & Space(5) &
xstrToLocation & _
strFilenameOfBE, vbInformation, "File Created"

End If

Else

MsgBox "No location was selected. No copy of the backend file will
be made.", _
vbExclamation, "No Location Selected"

End If

End If

Exit_CopyBackup:
On Error Resume Next
Set tdf_DB = Nothing
dbs_DB.Close
Set dbs_DB = Nothing
DoCmd.Hourglass False
Err.Clear
Exit Sub

Err_CopyBackup:
If Err.Number = 71 Then
MsgBox "The device that you selected ( """ & xstrToLocation & _
""" ) does not contain a disc or diskette. " & _
"The file cannot be copied to this device.", vbCritical, _
"No Disc or Diskette"
Else
MsgBox "An error has occurred while making a copy of the backend
database file:" & _
vbCrLf & " Error #" & Err.Number & ": " & Err.Description &
vbCrLf & vbCrLf & _
"Try again in a few minutes. If the problem persists, contact the
programmer for assistance.", _
vbCritical, "Error While Copying File"
End If
Resume Exit_CopyBackup

End Sub

' ********************************
' ** Function ExtractFileName **
' ********************************

Public Function ExtractFileName(ByVal strPathFile As String) As String
' *** THIS FUNCTION EXTRACTS THE "FILE NAME" PORTION OF A STRING THAT
HOLDS
' *** THE FULL PATH AND FILENAME FOR A FILE. IT DOES THIS BY DROPPING
' *** THE PATH PORTION FROM THE STRING (ALL TEXT BEFORE THE LAST
' *** "\" CHARACTER IN THE STRING, AND THAT LAST "\" CHARACTER, TOO).

' *** IF THERE IS NO "\" CHARACTER IN THE TEXT STRING, THE FUNCTION
RETURNS
' *** AN EMPTY STRING AS ITS VALUE. OTHERWISE, IT RETURNS THE "FILE NAME"
PORTION
' *** OF THE TEXT STRING.
' Ken Snell 19 May 2005

' strPathFile is string variable that contains the full path and filename
text string.

On Error Resume Next

If InStr(strPathFile, "\") = 0 Then
ExtractFileName = ""
Else
ExtractFileName = Mid(strPathFile, InStrRev(strPathFile, "\") + 1)
End If
Err.Clear
End Function




' ****************************
' ** Function ExtractPath **
' ****************************

Public Function ExtractPath(ByVal strPathFile As String) As String
' *** THIS FUNCTION EXTRACTS THE "PATH" PORTION OF A STRING THAT HOLDS
' *** THE FULL PATH AND FILENAME FOR A FILE. IT DOES THIS BY DROPPING
' *** THE FILENAME PORTION FROM THE STRING (ALL TEXT AFTER THE LAST
' *** "\" CHARACTER IN THE STRING).

' *** IF THERE IS NO "\" CHARACTER IN THE TEXT STRING, THE FUNCTION
RETURNS
' *** AN EMPTY STRING AS ITS VALUE. OTHERWISE, IT RETURNS THE "PATH"
PORTION
' *** (INCLUDING THE ENDING "\" CHARACTER) OF THE TEXT STRING.
' Ken Snell 19 May 2005

' strPathFile is string variable that contains the full path and filename
text string.

On Error Resume Next

If InStr(strPathFile, "\") = 0 Then
ExtractPath = ""
Else
ExtractPath = Left(strPathFile, InStrRev(strPathFile, "\"))
End If
Err.Clear
End Function
 
Back
Top