Public Sub findChanges()
Const oldData = "tblOldData"
Const newData = "tblNewData"
Const PK_ID = "ID"
Const changeTable = "tblChanges"
Dim rsOld As DAO.Recordset
Dim rsNew As DAO.Recordset
Dim fld As DAO.Field
Dim oldValue As Variant
Dim newValue As Variant
Dim ID As Long
Dim fldName As String
Dim fldPosition As Integer
Dim fldType As Long
Dim generalType As String
Dim strFields As String
Dim strValues As String
Dim strInsert As String
Dim strSql As String
Set rsOld = CurrentDb.OpenRecordset(oldData, dbOpenSnapshot)
Set rsNew = CurrentDb.OpenRecordset(newData, dbOpenSnapshot)
CurrentDb.Execute ("delete * from " & changeTable)
'strFields = insertFields("recordID", "fldName", "fldPosition", "oldVal", "newVal", "valtype")
strFields = insertFields("recordID", "fldName", "fldPosition")
strFields = "Insert into " & changeTable & " " & strFields
Debug.Print strInsert
Do While Not rsOld.EOF
ID = rsOld.Fields(PK_ID)
For Each fld In rsOld.Fields
oldValue = fld.Value
fldName = fld.Name
fldPosition = fld.OrdinalPosition
fldType = fld.Type
generalType = getGeneralType(fldType)
rsNew.FindFirst PK_ID & " = " & ID
If Not rsNew.NoMatch Then
newValue = rsNew.Fields(fld.Name).Value
End If
If oldValue <> newValue Then
strInsert = strFields & " values " & insertValues(ID, sqlTxt(fldName), fldPosition)
Debug.Print strInsert
'Select Case generalType
' Case "Text"
' Case "Numeric"
' Case "DateTime"
' Case "Boolean"
'End Select
CurrentDb.Execute strInsert
End If
Next fld
rsOld.MoveNext
Loop
End Sub
Public Function getGeneralType(dbType As Long) As String
'Purpose is to decide how to format the value in a sql search
'Single quotes, #date#, or no quotes
'Returns the following
' Text
' Numeric
' DateTime
' Boolean
'These are the constants
'dbBigInt Big Integer
'dbBinary Binary
'dbBoolean Boolean
'dbByte Byte
'dbChar Char
'dbCurrency Currency
'dbDate Date / Time
'dbDecimal Decimal
'dbDouble Double
'dbFloat Float
'dbGUID Guid
'dbInteger Integer
'dbLong Long
'dbLongBinary Long Binary (OLE Object)
'dbMemo Memo
'dbNumeric Numeric
'dbSingle Single
'dbText Text
'dbTime Time
'dbTimeStamp Time Stamp
'dbVarBinary VarBinary
Select Case dbType
Case dbText, dbChar, dbMemo
getGeneralType = "Text"
Case dbNumeric, dbSingle, dbDouble, dbLong, dbCurrency, dbBinary, dbBigInt, _
dbByte, dbGUID, dbInteger, dbLongBinary, dbVarBinary
getGeneralType = "Numeric"
Case dbDate, dbTime
getGeneralType = "DateTime"
Case dbBoolean
getGeneralType = "Boolean"
End Select
End Function
Public Function insertFields(ParamArray varfields() As Variant) As String
Dim fld As Variant
For Each fld In varfields
If insertFields = "" Then
insertFields = "([" & fld & "]"
Else
insertFields = insertFields & ", [" & fld & "]"
End If
Next fld
If Not insertFields = "" Then
insertFields = insertFields & ")"
End If
End Function
Public Function insertValues(ParamArray varValues() As Variant) As String
Dim varValue As Variant
For Each varValue In varValues
If IsNull(varValue) Then varValue = "NULL"
If insertValues = "" Then
insertValues = "(" & varValue
Else
insertValues = insertValues & ", " & varValue
End If
Next varValue
If Not insertValues = "" Then
insertValues = insertValues & ")"
End If
End Function
Public Function sqlTxt(varItem As Variant) As Variant
If Not IsNull(varItem) Then
varItem = Replace(varItem, "'", "''")
sqlTxt = "'" & varItem & "'"
End If
End Function
Function SQLDate(varDate As Variant) As Variant
If IsDate(varDate) Then
If DateValue(varDate) = varDate Then
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
Else
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
End If
End If
End Function
