Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Auto Backup of DB using Code? 4
- Thread starter cstringer
- Start date
- Thread starter
- #2
psemianonymous
Programmer
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.
Pete
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.
Pete
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 ":".
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 ":".
-
3
- #5
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
End If 'check for backup path parameter
strSourceFileWithPath = strSourcePath & BACKSLASH & strSourceFile
'TARGET SECTION
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, "Short Time"
strTargetFile = strTargetFile & "_BAK" & UNDERSCORE & strDateTag & ".mdb"
Else
strTargetFile = strTargetFile & "_BAK" & ".mdb"
End If
strTargetPath = strTargetPath & BACKUP_FOLDER
strTargetFileWithPath = strTargetPath & BACKSLASH & strTargetFile
If Not (FSO.FolderExists(strTargetPath)) Then
FSO.CreateFolder strTargetPath
End If
FSO.CopyFile strSourceFileWithPath, strTargetFileWithPath
MakeBackupCopy = True 'If here then it worked
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
Error_MakeBackupCopy:
MakeBackupCopy = False
RespondToError "MakeBackupCopy", Err.Number, Err.Description, _
"Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
Resume Exit_Error_MakeBackupCopy
End Function 'Function MakeBackupCopy [/tt]
Turn your headache into my project!
Jeffrey R. Roberts
Insight Data Consulting
Access and SQL Server Development
[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
End If 'check for backup path parameter
strSourceFileWithPath = strSourcePath & BACKSLASH & strSourceFile
'TARGET SECTION
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, "Short Time"strTargetFile = strTargetFile & "_BAK" & UNDERSCORE & strDateTag & ".mdb"
Else
strTargetFile = strTargetFile & "_BAK" & ".mdb"
End If
strTargetPath = strTargetPath & BACKUP_FOLDER
strTargetFileWithPath = strTargetPath & BACKSLASH & strTargetFile
If Not (FSO.FolderExists(strTargetPath)) Then
FSO.CreateFolder strTargetPath
End If
FSO.CopyFile strSourceFileWithPath, strTargetFileWithPath
MakeBackupCopy = True 'If here then it worked
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
Error_MakeBackupCopy:
MakeBackupCopy = False
RespondToError "MakeBackupCopy", Err.Number, Err.Description, _
"Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
Resume Exit_Error_MakeBackupCopy
End Function 'Function MakeBackupCopy [/tt]
Turn your headache into my project!
Jeffrey R. Roberts
Insight Data Consulting
Access and SQL Server Development
- Thread starter
- #6
scrollgomes
Programmer
Hi Jeffrey,
could you put the sintax for function (example).
Regards,
RG
could you put the sintax for function (example).
Regards,
RG
just have a boolean variable for the return--
dim blnBackupSuccess as Boolean
blnBackupSuccess = MakeBackupCopy(parameters)
Turn your headache into my project!
Jeffrey R. Roberts
Insight Data Consulting
Access and SQL Server Development
dim blnBackupSuccess as Boolean
blnBackupSuccess = MakeBackupCopy(parameters)
Turn your headache into my project!
Jeffrey R. Roberts
Insight Data Consulting
Access and SQL Server Development
this is a ready made pg without coding that allow u to backup your db while working
Dear All:
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
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
I copied to code and pasted it into a module within access and tried to call makebackupcopy from a button control using the following:
Private Sub Command6_Click()
Dim blnBackupSuccess As Boolean
blnBackupSuccess = MakeBackupCopy(True,True,True,"C:\")
End Sub
When I click on the button I get the error
Compile Error: User-defined type not defined
The Debugger stops on this line:
Dim FSO As New FileSystemObject
Is there a step that I am missing? Any help would be appreciated.
Chuck
Private Sub Command6_Click()
Dim blnBackupSuccess As Boolean
blnBackupSuccess = MakeBackupCopy(True,True,True,"C:\")
End Sub
When I click on the button I get the error
Compile Error: User-defined type not defined
The Debugger stops on this line:
Dim FSO As New FileSystemObject
Is there a step that I am missing? Any help would be appreciated.
Chuck
-
1
- #12
Now it stops at
RespondToError "MakeBackupCopy", Err.Number, Err.Description, "Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
with a "Sub or Function not Defined" error.
I tried cutting and re-pasting the code from the site. Any ideas????
RespondToError "MakeBackupCopy", Err.Number, Err.Description, "Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
with a "Sub or Function not Defined" error.
I tried cutting and re-pasting the code from the site. Any ideas????
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.
[tt]MsgBox Err.Number & " " & Err.Description[/tt]
Roy-Vidar
[tt]MsgBox Err.Number & " " & Err.Description[/tt]
Roy-Vidar
Roy,
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.
Thanks
Chuck
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.
Thanks
Chuck
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)
Roy-Vidar
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)
Roy-Vidar
Hey Chuck it's my bad...
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
strTargetPath = strTargetPath & BACKSLASH & BACKUP_FOLDER
strTargetFileWithPath = strTargetPath & BACKSLASH & strTargetFile
If Not (FSO.FolderExists(strTargetPath)) Then
FSO.CreateFolder strTargetPath
End If
FSO.CopyFile strSourceFileWithPath, strTargetFileWithPath
MakeBackupCopy = True 'If here then it worked
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
Error_MakeBackupCopy:
MakeBackupCopy = False
RespondToError "MakeBackupCopy", Err.Number, Err.Description, _
"Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
Resume Exit_Error_MakeBackupCopy
End Function 'Function MakeBackupCopy
[/tt]
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development
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
strTargetPath = strTargetPath & BACKSLASH & BACKUP_FOLDER
strTargetFileWithPath = strTargetPath & BACKSLASH & strTargetFile
If Not (FSO.FolderExists(strTargetPath)) Then
FSO.CreateFolder strTargetPath
End If
FSO.CopyFile strSourceFileWithPath, strTargetFileWithPath
MakeBackupCopy = True 'If here then it worked
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
Error_MakeBackupCopy:
MakeBackupCopy = False
RespondToError "MakeBackupCopy", Err.Number, Err.Description, _
"Database Backup Failed" & CRITICAL_ALERT, BLN_CRITICAL
Resume Exit_Error_MakeBackupCopy
End Function 'Function MakeBackupCopy
[/tt]
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development
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 Select
Exit_RespondToError:
Exit Sub
Error_RespondToError:
MsgBox "Error Response Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_RespondToError
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
LogErrorInTable v_strRoutine, v_lngErrorNum, v_strErrorDescription
LogErrorInTextFile v_strRoutine, v_lngErrorNum, v_strErrorDescription
Exit_LogError:
Exit Sub
Error_LogError:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_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
strUser = apiUserName
strObject = Application.CurrentObjectName
strSQL_INSERT = "insert into error_log " & _
"(user, current_object, routine, error_number,error_description, error_timestamp) " & _
"values (" & _
Chr(39) & strUser & Chr(39) & "," & _
Chr(39) & strObject & Chr(39) & "," & _
Chr(39) & v_strRoutine & Chr(39) & "," & _
v_lngErrorNum & "," & _
Chr(39) & v_strErrorDescription & Chr(39) & "," & _
Chr(35) & Now() & Chr(35) & ")"
DB.Execute strSQL_INSERT
Exit_LogErrorInTable:
Set DB = Nothing
Exit Sub
Error_LogErrorInTable:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTable
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
strPath = CurrentProject.Path
strErrorFile = APPLICATION_NAME & "_error_log.txt"
strUser = apiUserName
strErrMessage = vbCrLf & "Error logged: " & Format(Now(), "mmm-dd-yy hh:mm AM/PM") & vbCrLf & _
"User: " & strUser & vbCrLf & "Routine: " & v_strRoutine & vbCrLf & "ErrorNum: " & _
CStr(v_lngErrorNum) & vbCrLf & "Description: " & v_strErrorDescription & vbCrLf
intFile = FreeFile
'File will be created if not found
Open strErrorFile For Append As #intFile
Print #intFile, strErrMessage
Close #intFile
Exit_LogErrorInTextFile:
Exit Sub
Error_LogErrorInTextFile:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTextFile
End Sub 'LogError
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"
Case Else
strError = "Error Number: " & CStr(v_ErrorNum)
End Select
LogError "Data Error", v_ErrorNum, "Data Error"
strResponse = strResponse & strError
MsgBox strResponse, vbExclamation, APPLICATION_NAME
DataErrorResponse = acDataErrContinue
Exit_LogDataError:
Exit Function
Error_LogDataError:
Resume Exit_LogDataError
End Function 'DataErrorResponse
[/tt]
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development
[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 Select
Exit_RespondToError:
Exit Sub
Error_RespondToError:
MsgBox "Error Response Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_RespondToError
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
LogErrorInTable v_strRoutine, v_lngErrorNum, v_strErrorDescription
LogErrorInTextFile v_strRoutine, v_lngErrorNum, v_strErrorDescription
Exit_LogError:
Exit Sub
Error_LogError:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_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
strUser = apiUserName
strObject = Application.CurrentObjectName
strSQL_INSERT = "insert into error_log " & _
"(user, current_object, routine, error_number,error_description, error_timestamp) " & _
"values (" & _
Chr(39) & strUser & Chr(39) & "," & _
Chr(39) & strObject & Chr(39) & "," & _
Chr(39) & v_strRoutine & Chr(39) & "," & _
v_lngErrorNum & "," & _
Chr(39) & v_strErrorDescription & Chr(39) & "," & _
Chr(35) & Now() & Chr(35) & ")"
DB.Execute strSQL_INSERT
Exit_LogErrorInTable:
Set DB = Nothing
Exit Sub
Error_LogErrorInTable:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTable
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
strPath = CurrentProject.Path
strErrorFile = APPLICATION_NAME & "_error_log.txt"
strUser = apiUserName
strErrMessage = vbCrLf & "Error logged: " & Format(Now(), "mmm-dd-yy hh:mm AM/PM") & vbCrLf & _
"User: " & strUser & vbCrLf & "Routine: " & v_strRoutine & vbCrLf & "ErrorNum: " & _
CStr(v_lngErrorNum) & vbCrLf & "Description: " & v_strErrorDescription & vbCrLf
intFile = FreeFile
'File will be created if not found
Open strErrorFile For Append As #intFile
Print #intFile, strErrMessage
Close #intFile
Exit_LogErrorInTextFile:
Exit Sub
Error_LogErrorInTextFile:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTextFile
End Sub 'LogError
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"
Case Else
strError = "Error Number: " & CStr(v_ErrorNum)
End Select
LogError "Data Error", v_ErrorNum, "Data Error"
strResponse = strResponse & strError
MsgBox strResponse, vbExclamation, APPLICATION_NAME
DataErrorResponse = acDataErrContinue
Exit_LogDataError:
Exit Function
Error_LogDataError:
Resume Exit_LogDataError
End Function 'DataErrorResponse
[/tt]
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development
Jeff,
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.
Chuck
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.
Chuck
Chuck,
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
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
- Status
Similar threads
- Locked
- Question
- Locked
- Question
- Locked
- Question