Message reason why Execute method failed - ms-access

I use the DAO method Execute to delete some records. If this fails this is clear by checking RecordsAffected (it will be 0). But is it possible to get the error message (for instance, to log or to show to the user)? I've try to delete the records by hand in the Table grid I get a clear dialog message, e.g. "The record cannot be deleted or changed because tabel x includes related records".

Include the dbFailOnError option with the Execute method to capture your DELETE errors. Without dbFailOnError, your DELETE can fail silently.
Relying on RecordsAffected to indicate a DELETE failure can be misleading. For example if your DELETE includes "WHERE Sample=5", and there is no row with a Sample value of 5, RecordsAffected will be 0. That is not an error to the database engine.
In the following sample, the DELETE fails because there is a relationship, with referential integrity enforced, between tblParent and tblChild. So the message box says "The record cannot be deleted or changed because table 'tblChild' includes related records".
Public Sub DeleteFailure()
Dim strSql As String
Dim strMsg As String
Dim db As DAO.Database
On Error GoTo ErrorHandler
strSql = "DELETE FROM tblParent WHERE id = 1;"
Set db = CurrentDb
db.Execute strSql, dbFailOnError
ExitHere:
On Error GoTo 0
Debug.Print "RecordsAffected: " & db.RecordsAffected
Set db = Nothing
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure DeleteFailure"
MsgBox strMsg
GoTo ExitHere
End Sub
Update: Here is a revised ErrorHandler to accommodate multiple errors triggered by a DAO operation.
ErrorHandler:
Dim errLoop As Error
Debug.Print "Errors.Count: " & Errors.Count
For Each errLoop In Errors
With errLoop
strMsg = "Error " & Err.Number & " (" & _
Err.Description & _
") in procedure DeleteFailure"
End With
MsgBox strMsg
Next
Set errLoop = Nothing
GoTo ExitHere

It should be possible to use DBEngine errors: http://msdn.microsoft.com/en-us/library/bb177491(office.12).aspx

Related

Run-Time error '3075' Syntax error (missing operator) in query expression 'id='

I was trying to create script that will do soft deletion. Apparently, there was a run-time error I encountered after running the script. Please help.
Private Sub cmdDelete_Click()
Dim db As DAO.Database
'delete record
'check existing selected record
'If Not (Me.frmGatewaySub.Form.Recordset.EOF And Me.frmGatewaySub.Form.Recordset.BOF) Then
'confirm deletion
If MsgBox("Are you sure you want to soft delete this?", vbYesNo) = vbYes Then
'soft delete now
Set db = CurrentDb
Call db.Execute( _
"Update dbo_gateway" & _
" set deleted_at= now()" & _
" where id=" & Me.txtID.Value, dbSeeChanges)
'clear text box
cmdClear_Click
Me.frmGatewaySub.Form.Requery
End If
'End If
End Sub
Your textbox is empty, thus:
" where id=" & Me.txtID.Value, dbSeeChanges)
becomes:
" where id="
So, double-check your code and prevent it from running if txtID is Null.

Ignore error 58 when renaming files

I've got a small Access program that looks up files names from a query ("qryImagesToRename"), goes through a loop and renames them. However, if an image already exists with the same name Access wants to rename it to, I receive
error 58 - File Already Exists
How do I ignore this error and continue with the loop? This my code:
Private Sub Command10_Click()
On Error GoTo Command10_Click_Error
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
DoCmd.Hourglass True
Set db = CurrentDb
strSQL = "select * from qryImagesToRename"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
Name rs.Fields("From").Value As rs.Fields("To").Value
rs.MoveNext
Loop
DoCmd.Hourglass False
MsgBox "All matching files renamed"
On Error GoTo 0
Exit Sub
Command10_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command10_Click of VBA Document Form_frmRename - Please take a screenshot and email xxxxxx#xxxxxxx.com"
End Sub
If you are certain that you can ignore the error then you could use On Error Resume Next to ignore it and continue processing. Ensure that you add On Error Goto 0 as soon as you can, to reinstate the normal error processing.
On Error Resume Next
Do While Not rs.EOF
Name rs.Fields("From").Value As rs.Fields("To").Value
rs.MoveNext
Loop
On Error GoTo 0
This is most often a poor practice, but can be used if there is certainty about behaviour.
A better practice would be to check if the file already exists using Dir (or FileSystemObject) and skip it. Discussed here
Two particular solutions come to mind. The first, is in-line logic to check for the existing file, and skip that item, and the second is to put a case statement in the error handler. I have outlined the code below to have both options. I hope it helps.
Private Sub Command10_Click()
On Error GoTo Command10_Click_Error
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim fso as New FileSystemObject
DoCmd.Hourglass True
Set db = CurrentDb
strSQL = "select * from qryImagesToRename"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF 'if you want to use the logic inline, use the check below
If fso.fileexists(rs.Fields("To").value) = false Then
Name rs.Fields("From").Value As rs.Fields("To").Value
End If
NextRecord: 'if you want to use the goto statement, use this
rs.MoveNext
Loop
DoCmd.Hourglass False
MsgBox "All matching files renamed"
On Error GoTo 0
Exit Sub
Command10_Click_Error:
Select case Err.number
Case 58
GoTo NextRecord
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command10_Click of VBA Document Form_frmRename - Please take a screenshot and email xxxxxx#xxxxxxx.com"
End select
End Sub

Can't save to local table when network access is interrupted.

I have a split database where the backend is located remotely; when I get the error "Network access has been interrupted" I want to log something on a local table for future access. After creating a system for this I found out that when the connection is lost to the remote backend the local tables also become inaccessible.
While I don't think there is necessarily a solution to this I want to find out why the local tables aren’t accessible when clearly they shouldn't require a network connection to be used. The following is the code for my function that I use to try and log locally.
Public Function LogTempError(ByVal lngErrNumber As Long, _
ByVal strErrDescription As String, _
strCallingProc As String, _
Optional varParameters As Variant, _
Optional blnSHOW_USER As Boolean = True) As Boolean
On Error GoTo Err_Handler
'Set warnings to True just in case the error happened while they were set to false.
DoCmd.SetWarnings True
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("TempErrorTable", dbOpenDynaset, dbAppendOnly)
With rs
.AddNew
!ERROR_LOG_NUMBER = lngErrNumber
!ERROR_LOG_USERID = NetworkUserName()
!ERROR_LOG_DESCRIPTION = strErrDescription & " logged from Temp Table"
!ERROR_LOG_TIMESTAMP = Now()
!ERROR_LOG_FORM = strCallingProc
.Update
End With
Exit_Handler:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Function
Err_Handler:
If DateDiff("s", dteLAST_ERROR_TIME, Now()) > 20 Or lngLAST_ERROR_NUMBER <> lngErrNumber Then
' If there are more errors that can't be logged, simply email the errors.
SendEmail "First Unloggable error", "Error Num: " & Err.Number & " Error Description: " & strErrDescription & " From: " & strCallingProc
SendEmail "Second Unloggable error", "Error Num: " & Err.Number & " Error Description: " & Err.Description & " From: " & strCallingProc
MsgBox "An error occured that wasn't able to be logged, a message was sent to Database Administrator on your behalf.", vbInformation, "Notification Sent"
End If
Resume Exit_Handler
End Function
Try this slightly stripped-down version, which opens the connection to TempErrorTable on first use, and keeps the connection open. Let it stop on errors within LogTempError so you can see where the TempErrorTable update is failing.
Public Function LogTempError(ByVal lngErrNumber As Long, _
ByVal strErrDescription As String, _
strCallingProc As String, _
Optional varParameters As Variant, _
Optional blnSHOW_USER As Boolean = True) As Boolean
Static rs As Recordset
On Error GoTo 0
DoCmd.SetWarnings True
If rs Is Nothing Then ' open recordset on first use
Set rs = CurrentDb.OpenRecordset("TempErrorTable", dbOpenDynaset, dbAppendOnly)
End If
With rs
.AddNew
!ERROR_LOG_NUMBER = lngErrNumber
!ERROR_LOG_USERID = NetworkUserName()
!ERROR_LOG_DESCRIPTION = strErrDescription & " logged from Temp Table"
!ERROR_LOG_TIMESTAMP = Now()
!ERROR_LOG_FORM = strCallingProc
.Update
End With
Exit Function

Reading error message for message box from table

I am trying to display error message in MS Access which will get the error from one table.
There is a table, having only one column which is having error records. I need to display all the records from table in message box of ms access.
I know how to get the message box but unable to find how to fetch records in the msg box
MsgBox "Errors are :" & vbCr & _
"E.g. 000123", vbCritical + vbOKOnly
How can i get the values from table?
Add this sub in your form or a stand alone module :
Public Sub DisplayErrors()
Dim RS As Recordset
Dim strErrors as string
Set RS = CurrentDb.OpenRecordset("SELECT * FROM MyErrorTable")
If Not RS.BOF Then
While Not RS.EOF
strErrors = strErrors & RS!MyErrorField & vbCrLf & vbCrLf
RS.MoveNext
Wend
End If
RS.Close
Set RS = Nothing
MsgBox "Errors are : " & vbCrLf & strErrors , vbCritical + vbOKOnly
End Sub
Replace MyErrorTable and MyErrorField with the name of your table and it's unique field containing the errors.
Then call your sub from anywhere with :
DisplayErrors

compile error: expected end of statement

A Microsoft Access 2010 database is giving me the following error message:
Compile Error: Expected End Of Statement
Here is the method that is throwing the error message:
Private Sub Form_BeforeUpdate(Cancel As Integer)
'Provide the user with the option to save/undo
'changes made to the record in the form
If MsgBox("Changes have been made to this record." _
& vbCrLf & vbCrLf & "Do you want to save these changes?" _
, vbYesNo, "Changes Made...") = vbYes Then
DoCmd.Save
Else
DoCmd.RunCommand acCmdUndo
End If
Dim sSQL As String
sSQL = "SELECT max(Clients.ClientNumber) AS maxClientNumber FROM Clients"
Dim rs As DAO Recordset
Set rs = CurrentDb.OpenRecordset(sSQL)
MsgBox ("Max client number is: " & rs.Fields(1))
End Sub
The line of code that is throwing the error message is:
Dim rs As DAO Recordset
I am not sure if the problem has to do with the syntax of what is on the line preceding it. Can anyone show how to fix this problem? And explain what is going on?
You are missing a full stop (period) between the DAO and the Recordset - it should be
Dim rs As DAO.Recordset
Beyond that, you will also have a runtime error on reading the field value, since a DAO Fields collection is indexed from 0, not 1. Hence, change the penultimate line to this:
MsgBox ("Max client number is: " & rs.Fields(0))
Alternatively, reference the field by its name:
MsgBox ("Max client number is: " & rs!maxClientNumber)
You're mising the semicolon at the end of your Sql statement