Yes. There are two problems with doing it the easy way:
1. What if someone else is already in the database?
2. How can you back up the database by copying the file, if you have the file itself open ?
So #2 can be solved by opening some sort of intermediate MDB file, like "launch.MDB". But to solve #1, there is no truly good answer.
The recommended way to do backups is to have a regularly scheduled backup that happens during off-hours. You can schedule tasks via Task Manager, but the machine must be running 24/7, so a server machine is ideal.
So an example would be: at 3AM every morning, copy every file in the directory \\FILESERVERNAME\VOLUME\ETC\ETC\ to a new folder, of the form \\OTHERFILESERVER\ETC\YYYY-MM-DD
So back to the original question. It's possible, but it's not recommended. Consider the above method instead.
Not sure if this would apply to you, but I built a small inventory cost tracking database. There are about 10 tables in there but 3 main tables that holds most of the data.
What I did was on the main menu form. I created a close button that before it close it exports the 3 tables as an excel file with the current date and time without any of the slashes "/" and colons ":".
You can back up an mdb with users in it. Here's code that does it--you'll have to tweak it for your context:
[tt]
Public Function MakeBackupCopy(p_Archive As Boolean, p_Alert As Boolean, p_ShowLocation As Boolean, _
Optional p_BackupPath As String) As Boolean
On Error GoTo Error_MakeBackupCopy
Const BACKUP_FOLDER As String = "\Backup"
Const BACKSLASH As String = "\"
Const UNDERSCORE As String = "_"
Dim strCompletedAlert As String
Dim strSourceFile As String
Dim strSourcePath As String
Dim strSourceFileWithPath As String
Dim strDateTag As String
Dim strTargetFile As String
Dim strTargetPath As String
Dim strTargetFileWithPath As String
Dim FSO As New FileSystemObject
Dim TDF As DAO.TableDef
MakeBackupCopy = False 'Set default
'SOURCE SECTION
If Len(p_BackupPath) Then
strTargetPath = p_BackupPath
Else
strSourceFile = CurrentProject.NAME 'Default value of Front End file
strSourcePath = CurrentProject.Path 'Default value of Front End path
'GetBackEnd Path of linked tables overwrite BEPath
For Each TDF In CurrentDb.TableDefs
If Len(TDF.Connect) Then
strSourceFile = TDF.Connect
'if password in Connect string there are 2 ='s so use Instr Reverse
strSourceFile = Mid(strSourceFile, (InStrRev(strSourceFile, "=" + 1))
strSourcePath = Left(strSourceFile, ((InStrRev(strSourceFile, "\" - 1)))
'One table is sufficient
Exit For
End If
Next
strTargetPath = strSourcePath 'if linked Back End put Backup there
If p_Alert Then
If p_ShowLocation Then
strCompletedAlert = "Backup Completed" & vbCrLf & "Backup Copy:" & strTargetFileWithPath
Else
strCompletedAlert = "Backup Completed"
End If
MsgBox strCompletedAlert, vbInformation, APPLICATION_NAME
End If
Exit_Error_MakeBackupCopy:
Set TDF = Nothing
Set FSO = Nothing
Exit Function
I have query and I want to transfer the data into a chart, I tried the chart option and failed, it there a way I can get a chart into a Form, In the chart I need to present the percentage too.
Ex: my query carries
Ministry name and the Total Support. which I need to place in a chart as a percentage.
Appreciate your valuable advices...
thanks and have a good day
Just guessing here, but I believe that is a routine Quehay uses to either logg the error, or a custom error msgbox. I haven't used his code, so this is (as said) guessing. I think you can replace it with an ordinary msgbox, if you don't want to crate your own routine for such.
Thanks for the help. I gave you a star for all your help an patience. It finally runs, but now the errorbox pops up because of an invalid procedure call. I used the this code to call the function:
Private Sub Command6_Click()
Dim blnBackupSuccess As Boolean
blnBackupSuccess = MakeBackupCopy(True,True,True,"C:\")
End Sub
I know that this type of work is advanced for my level, but it will really pay off at work if I can get this to run.
Haven't got much time to play with it now, I'm afraid, thanx for the star!
With me it errors on three conditions:
1 - if I pass an optional backup path, try calling without:
[tt] blnBackupSuccess = MakeBackupCopy(True,True,True)[/tt]
2 - if I run it on a database connected to MSDE (SQL server)
3 - if I run it on a database with an access backend (other errormsg, though)
So - if your challenge now is only backup the current database, use the suggestion from para 1 above, else try amending yourself, or specify your situation, and I might have time later today or tomorrow (or some others might jump in)
I had a logic error (in checking whether a backup path was passed in or not) and an error in path building as well, given different parameters. I apologize for submitting something that I hadn't yet tested with every possible parameter combination.
Roy's right the error handling is a separate routine--I originally submitted this with the idea that this would be transparent--not intending to be elitist but just thinking that was the audience.
The error trapping stuff is pretty good (I think), and I'll submit it in a second post that doesn't clutter this one. Here's the corrected code for "hot backup" :
[tt]Public Function MakeBackupCopy(p_Archive As Boolean, p_Alert As Boolean, p_ShowLocation As Boolean, _
Optional p_BackupPath As String) As Boolean
On Error GoTo Error_MakeBackupCopy
Const BACKUP_FOLDER As String = "Backup"
Const BACKSLASH As String = "\"
Const UNDERSCORE As String = "_"
Dim strCompletedAlert As String
Dim strSourceFile As String
Dim strSourcePath As String
Dim strSourceFileWithPath As String
Dim strDateTag As String
Dim strTargetFile As String
Dim strTargetPath As String
Dim strTargetFileWithPath As String
Dim FSO As New FileSystemObject
Dim TDF As DAO.TableDef
MakeBackupCopy = False 'Set default
strSourceFile = CurrentProject.name 'Default value of Front End file
strSourcePath = CurrentProject.Path 'Default value of Front End path
'SOURCE SECTION
'If there are linked tables get path to them and use for source path
For Each TDF In CurrentDb.TableDefs
If Len(TDF.Connect) Then
strSourceFile = TDF.Connect
'if password in Connect string there are 2 ='s so use Instr Reverse
strSourceFile = Mid(strSourceFile, (InStrRev(strSourceFile, "=") + 1))
strSourcePath = Left(strSourceFile, ((InStrRev(strSourceFile, "\") - 1)))
'One table is sufficient
Exit For
End If
Next
strSourceFileWithPath = strSourcePath & BACKSLASH & strSourceFile
'TARGET SECTION
If Len(p_BackupPath) Then
strTargetPath = p_BackupPath
Else
strTargetPath = strSourcePath 'if linked Back End put Backup there
End If 'check for backup path parameter
strTargetFile = CurrentProject.name 'Use existing FE filename + date tag for TargetFile
strTargetFile = Left(strTargetFile, (Len(strTargetFile) - 4)) 'Remove File Extension
If p_Archive Then 'Overwrite one backup copy or archive w/ date tag?
strDateTag = Format(Date, "medium date") & UNDERSCORE & Format(Now, "hh-mm")
strTargetFile = strTargetFile & "_BAK" & UNDERSCORE & strDateTag & ".mdb"
Else
strTargetFile = strTargetFile & "_BAK" & ".mdb"
End If
If p_Alert Then
If p_ShowLocation Then
strCompletedAlert = "Backup Completed" & vbCrLf & "Backup Copy:" & strTargetFileWithPath
Else
strCompletedAlert = "Backup Completed"
End If
MsgBox strCompletedAlert, vbInformation, APPLICATION_NAME
End If
Exit_Error_MakeBackupCopy:
Set TDF = Nothing
Set FSO = Nothing
Exit Function
Here's the error handling. It involves some constants that I lifted from a separate constants module. A table is required for the errors, so either create it based on fields listed in routine or turn of "log in table" and just log in a text file.
[tt]
Public Const APPLICATION_NAME As String = "InsightDeveloperLibrary"
Public Const CRITICAL_ALERT As String = vbCrLf & vbCrLf & "Please Contact Insight Data Consulting"
'---------------------------------------------------
'Error Message for global use
Public Const BLN_CRITICAL As Boolean = True
Public Const ERROR_ALERT As String = "An error occurred"
Public Const ERROR_LOGGED_ALERT As String = "An error occured and has been logged"
'Refers to error generated when DoCmd cancelled
Public Const ACTION_CANCELLED As Long = 2501
'Data Error Constants
Public Const DUPLICATE_INDEX As Long = 3022
Public Const NULL_KEY_FIELD As Long = 3058
Public Const WRITE_CONFLICT As Long = 3197
Public Const RECORD_LOCKED As Long = 3260
Public Const NON_DATE As Long = 2113
Public Const LINK_FAILED As Long = 7971
Public Const NOT_IN_LIST As Long = 2237
Public Const NULL_REQUIRED_FIELD As Long = 3314
Public Const CHILD_RECORD As Long = 3200
Public Sub RespondToError(ByVal v_strRoutine As String, ByVal p_ErrorNum As Long, _
ByVal p_strErrorMsg As String, Optional p_Response As String, Optional p_Critical As Boolean)
On Error GoTo Error_RespondToError
Const DEFAULT_ERROR_MESSAGE As String = "An error occurred and has been logged"
Dim strResponse As String
Dim MessageClass As Long
MessageClass = vbInformation
If Len(p_Response) Then
strResponse = p_Response
If p_Critical Then
MessageClass = vbCritical
End If
Else
strResponse = DEFAULT_ERROR_MESSAGE
End If
Select Case p_ErrorNum
Case ACTION_CANCELLED
'Do nothing
Case CHILD_RECORD
MsgBox "Parent record may not be deleted with related records in place" & _
vbCrLf & "Use the ""DELETE"" buttons in the subform", vbExclamation, _
APPLICATION_NAME
Case Else
MsgBox strResponse, MessageClass, APPLICATION_NAME
LogError v_strRoutine, p_ErrorNum, p_strErrorMsg
End Sub 'RespondToError
Public Sub LogError(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
On Error GoTo Error_LogError
End Sub
Public Sub LogErrorInTable(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
'*Requires tbl_ErrorLog
On Error GoTo Error_LogErrorInTable
Dim DB As DAO.Database
Set DB = CurrentDb()
Dim strSQL_INSERT As String
Dim strUser As String
Dim strObject As String
Dim strSQL_CREATE As String
End Sub 'LogErrorInTable
Public Sub LogErrorInTextFile(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
On Error GoTo Error_LogErrorInTextFile
Dim intFile As Integer
Dim strErrMessage As String
Dim strPath As String
Dim strErrorFile As String
Dim strPrompt As String
Dim strUser As String
Public Function DataErrorResponse(ByVal v_ErrorNum As Integer) As Integer
On Error GoTo Error_LogDataError
Dim strResponse As String
Dim strError As String
strResponse = "A data error has occurred:" & vbCrLf & vbCrLf
Select Case v_ErrorNum
Case DUPLICATE_INDEX
strError = "You've attempted to enter a duplicate value where not allowed" & _
vbCrLf & "Remove or change the duplicate selection or Cancel"
Case NULL_KEY_FIELD
strError = strError = "An entry is missing for a required field" & _
vbCrLf & "Make sure that there are values in fields that are underlined"
Case WRITE_CONFLICT
strError = "Another user is attempting to update the same record-try to save again in a few minutes" & _
vbCrLf & "Use Cancel button to cancel the entry if needed"
Case RECORD_LOCKED
strError = "Another user is attempting to update the same record-try to save again in a few minutes" & _
vbCrLf & "Use Cancel button to cancel the entry if needed"
Case NON_DATE
strError = "The data entered does not match the field datatype--be sure to enter a date"
Case LINK_FAILED
strError = "The hyperlink is not valid"
Case NOT_IN_LIST
strError = "The field is limited to existing entries only" & _
vbCrLf & "Choose a value from the list"
Case NULL_REQUIRED_FIELD
strError = "An entry is missing for a required field" & _
vbCrLf & "Make sure that there are values in fields that are underlined"
Copied all the code and tried again. I am getting a Error 71 Disk not ready. I even tried setting the location to C:\ just to see what would happen. I have a couple of linked tables in my database that are offline right now, would that cause the funtion to error or am I just missing something when I call the funtion.
The disk not ready sounds like a hardware error of some sort. Are you able, with windows explorer, to see the .mdb file on the back end and do file copy with it? (Which, of course is all that this routine does--it's just the convenience of making it automatic and writing the file name for you).
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.