Monday, October 18, 2010

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 = 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



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![Corrected] = "yes"




rst![LastChecked] = Now()


End If




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


Set rst = Nothing

Set db = Nothing

Exit Sub


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

'Clear error after processed


End Sub

No comments:

Post a Comment