Automatically Assign ID Number to Set of Records and Loop
-
- NewLounger
- Posts: 3
- Joined: 15 Nov 2010, 22:52
Automatically Assign ID Number to Set of Records and Loop
Continuation for Hans. How can I upload my file for only your eyes? I've stripped personal information but I don't want my code out there for all to see.
-
- Administrator
- Posts: 78556
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Automatically Assign ID Number to Set of Records and Loo
Hi Dana,
Welcome to Eileen's Lounge!
We generally prefer attachments to be available to anyone, but I'll send you a private message with information where you can send the file. Watch your private messages.
Welcome to Eileen's Lounge!
We generally prefer attachments to be available to anyone, but I'll send you a private message with information where you can send the file. Watch your private messages.
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78556
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Automatically Assign ID Number to Set of Records and Loo
I have received your database and looked at it, but it's not clear to me where I should look for unassigned records. Could you explain? Thanks!
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78556
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Automatically Assign ID Number to Set of Records and Loo
Here is some code you can use (also posted in Microsoft Answers)
Code: Select all
Private Sub cmdAssignTest_Click()
Dim strCongregationID As String
Dim strUserID As String
Dim lngBatchSize As Long
Dim lngOldTerritoryID As Long
Dim lngNewTerritoryID As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rst2 As Recordset
Dim strSQL As String
Dim lngRecordCount As Long
Dim lngCurrentRecord As Long
Dim strTerritoryName As String
On Error GoTo ErrHandler
lngBatchSize = 30
lngOldTerritoryID = 106
strCongregationID = DLookup("CongregationID", "tblVar")
strUserID = DLookup("UserID", "tblVar")
strTerritoryName = Me.TerritoryName
strSQL = "SELECT * FROM tblSurveyData WHERE CityID=" & strCityID & _
" AND TerritoryTypeID=" & strTerritoryTypeID & _
" AND TerritoryID=" & lngOldTerritoryID
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
If rst.EOF Then
MsgBox "No records!", vbExclamation
GoTo ExitHandler
End If
rst.MoveLast
rst.MoveFirst
lngRecordCount = rst.RecordCount
' Get highest TerritoryNumber
lngTerritoryNumber = DMax("TerritoryNumber", "tblTerritory", _
"CityID=" & strCityID & " AND TerritoryTypeID=" & strTerritoryTypeID)
Set rst2 = dbs.OpenRecordset("tblTerritory", dbOpenDynaset)
' Loop
lngCurrentRecord = 0
Do While Not rst.EOF
lngCurrentRecord = lngCurrentRecord + 1
If lngCurrentRecord Mod lngBatchSize = 1 Then
' Do we have enough records left?
If lngRecordCount - lngCurrentRecord >= lngBatchSize \ 2 _
Or lngCurrentRecord = 1 Then
' Create new territory
lngTerritoryNumber = lngTerritoryNumber + 1
rst2.AddNew
rst2!TerritoryNumber = lngTerritoryNumber
rst2!TerritoryTypeID = strTerritoryTypeID
rst2!CityID = strCityID
rst2!CongregationID = strCongregationID
rst2!EnteredBy = strUserID
rst2!TerritoryName = strTerritoryName
' Remember new ID
lngNewTerritoryID = rst2!TerritoryID
rst2.Update
End If
End If
' Assign territory
rst.Edit
rst!TerritoryID = lngNewTerritoryID
rst.Update
rst.MoveNext
Loop
ExitHandler:
On Error Resume Next
rst.Close
rst2.Close
Set dbs = Nothing
Me.Requery
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Best wishes,
Hans
Hans