VBA to compare local and server table

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

Option Explicit



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')) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL)



'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])) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL1)



'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])) "



DoCmd.SetWarnings True

DoCmd.RunSQL (strSQL2)



'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"

Exit Sub

Else

rst.MoveFirst

End If



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.Edit

rst![Corrected] = "yes"

rst.Update

Else

rst.Edit

rst![LastChecked] = Now()

rst.Update

End If



rst.MoveNext



Loop



rst.Close



MsgBox "Corrected UserIDs Marked", vbInformation, "Finished!"



Finish:

Set rst = Nothing

Set db = Nothing



Exit Sub



ErrorHandler:

MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

'Clear error after processed

Err.Clear

End Sub