Kurt copy and paste this code into a module
then call UpdateAllSetUpIDs() from anywhere
and you should be good to go!
______________________________________________________________
Option Compare Database
Option Explicit
Private plngSetUpID As Long
Public Function UpdateAllSetUpIDs()
Call SetSetUpID
If plngSetUpID <> 0 Then Call UpdateSetUpID
End Function
Private Function GetSetUpID() As Long
GetSetUpID = plngSetUpID
End Function
Private Function SetSetUpID()
Dim daoDbs As DAO.Database
Dim daoRec As DAO.Recordset
Dim strSql As String
Set daoDbs = CodeDb
strSql = _
"SELECT tblMyCompanyInformation.SetupID " & _
"FROM tblMyCompanyInformation;"
Set daoRec = daoDbs.OpenRecordset(strSql)
If Not (daoRec.BOF And daoRec.EOF) Then
plngSetUpID = daoRec("SetupID").Value
Else
plngSetUpID = 0
End If
strSql = ""
daoRec.Close
daoDbs.Close
End Function
Private Function UpdateSetUpID()
Dim objectAccessObject As AccessObject
For Each objectAccessObject In CurrentData.AllTables
If ((Left(objectAccessObject.Name, 4) <> "MSys") And
(objectAccessObject.Name <> "tblMyCompanyInformation")) Then
GetTableFields (objectAccessObject.Name)
End If
Next objectAccessObject
End Function
Private Function GetTableFields(pstrTableName As String)
Dim objTdefs As TableDefs
Dim objTdef As TableDef
Dim lngFldCount As Long
Set objTdefs = CurrentDb.TableDefs
Set objTdef = objTdefs(pstrTableName)
For lngFldCount = 0 To objTdef.Fields.Count - 1
If objTdef.Fields(lngFldCount).Name = "SetupID" Then
UpdateTableField (pstrTableName)
End If
Next lngFldCount
End Function
Private Function UpdateTableField(pstrTableName As String)
Dim daoDbs As DAO.Database
Dim strSql As String
Set daoDbs = CodeDb
strSql = _
"UPDATE " & pstrTableName & " SET " & pstrTableName & ".SetupID = "
& GetSetUpID() & ";"
daoDbs.Execute strSql, dbSeeChanges
strSql = ""
daoDbs.Close
End Function
____________________________________________________________________
-- Take Care & God Bless ~ SPARKER ~
