Problem: Server tables have duplicate UserIDs for single entities. I correct this in my local table and then insert a new record into an “Errors” database table called “MoreThanOneUserID”. The table stores all errors, and has a field called Corrected which is formatted as a Yes/No field, another field called LastChecked is also present. I need to find all the new errors and all previous errors that were not corrected and send these to a systems admin for update to Server tables. In order to do this quickly and efficiently I wrote the following VBA code. I tried to add comments so it would be easy to understand. The VBA uses a Make Table Query, Several Update Queries, Recordset, Do…Loop, and ErrorHandler. I have stored the VBA in a module in my local table and have buttons on a form which calls the procedure and then open the respective tables after the procedure is run. I then am able to filter records that are not corrected, and paste or export them into an Excel spreadsheet. I have about 5 different modules that update corrections for different errors. Fun to write..and works, although I wonder if there is an evern better way to do this, I would love some feedback.
Option Compare Database
Public Sub CheckForUpdate ()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
On Error GoTo ErrorHandler
'Open Current Database
Set db = CurrentDb
db.QueryTimeout = 0
'Make New Table called UserIDUpdate from local and server tables
strSQL = "SELECT”
strSQL = strSQL & " MoreThanOneUserID.UniqueID, MoreThanOneUserID.UserID, MoreThanOneUserID.ServerUserID, MoreThanOneUserID.Corrected"
strSQL = strSQL & " INTO UserIDUpdate "
strSQL = strSQL & " FROM MoreThanOneUserID "
strSQL = strSQL & " WHERE (((MoreThanOneUserID.Corrected Is Null Or (MoreThanOneUserID.Corrected) <> 'Yes')) "
'Update ServerUserID in UserIDUpdate Table from data on Server Table
strSQL1 = "UPDATE”
strSQL1 = strSQL1 & " UserIDUpdate INNER JOIN dbo_ServerTable "
strSQL1 = strSQL1 & " ON UserIDUpdate.UniqueID = dbo_ServerTable.UniqueID "
strSQL1 = strSQL1 & " SET UserIDUpdate.ServerUserID = [dbo_ServerTable].[UserID] "
strSQL1 = strSQL1 & " WHERE (((UserIDUpdate.ServerUserID) Is Null)) OR (((UserIDUpdate.ServerUserID)<>[dbo_ServerTable].[UserID])) "
'Update Local ServerUserID from newly created UserIDUpdate Table
strSQL2 = "UPDATE”
strSQL2 = strSQL2 & " MoreThanOneUserID INNER JOIN UserIDUpdate "
strSQL2 = strSQL2 & " ON MoreThanOneUserID.UniqueID = UserIDUpdate.UniqueID "
strSQL2 = strSQL2 & " SET MoreThanOneUserID.ServerUserID = [UserIDUpdate].[ServerUserID]"
strSQL2 = strSQL2 & " WHERE (((MoreThanOneUserID.ServerUserID) Is Null)) OR (((MoreThanOneUserID.ServerUserID)<>[UserIDUpdate].[ServerUserID])) "
'Open Current DB Recordset
strSQL3 = "SELECT”
strSQL3 = strSQL3 & " Trim([UserID]) AS strUserID, Trim([ServerUserID]) AS strServerUserID, MoreThanOneUserID.Corrected, MoreThanOneUserID.LastChecked "
strSQL3 = strSQL3 & " FROM MoreThanOneUserID "
strSQL3 = strSQL3 & " WHERE (((Trim([ServerUserID])) Is Not Null) AND ((MoreThanOneUserID.Corrected) Is Null Or (MoreThanOneUserID.Corrected)<>'Yes'))"
Set rst = db.OpenRecordset(strSQL3)
'If strUserID=strServerUserID then update Corrected field = "yes", otherwise LastChecked = CurrentDate
'Check for records, EOF = End of Field
If rst.EOF Then
MsgBox "No records exist in recordset", vbExclamation, "VB Module Exit"
Do While Not rst.EOF
Dim strUserID, strServerUserID As String
‘Set string equal to recordset or rst values
strUserID = rst!strUserID
strServerUserID = rst!strServerUserID
If strUserID = strServerUserID Then
rst![Corrected] = "yes"
rst![LastChecked] = Now()
MsgBox "Corrected UserIDs Marked", vbInformation, "Finished!"
Set rst = Nothing
Set db = Nothing
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
'Clear error after processed