PDilly,
This is the gate for the fishing lake, right? I had made some suggestions when you were trying to create the db, do you remember?
Now, I think the fields used, Permno and Kseason, should not be in the New_Key_Register table. This is what is called data redundancy.
The following query returns the same information:
Code:
SELECT New_key_register.ID,
New_key_register.Keyno,
Not IsNull([NEWKEY]) AS InUse,
No_key.APERMNO AS KPERMNO,
No_key.SEASON AS KSEASON
FROM New_key_register LEFT JOIN No_key
ON New_key_register.Keyno = No_key.NEWKEY;
In actually, I am little a bit confused with the different seasons in two tables for the same records. Could you please explain that?
If I have understood correctly, the following function runs a bulk issue for the chosen season:
Code:
Function IssuedKeys(Optional intYear As Integer) As Long
Dim rsNew As DAO.Recordset
Dim rsIssued As DAO.Recordset
Dim db As DAO.Database
Dim i As Integer
Dim strSQLReg As String
Dim strSQLIssued As String
On Error GoTo ErrH
If intYear = 0 Then
'No specific input year.
'Get current year.
intYear = Year(Date)
End If
'SQL for the members of the given year.
strSQLIssued = "SELECT APERMNO, SEASON, NEWKEY FROM No_key " _
& "WHERE SEASON=" & intYear
'SQL for the available keys for the given year.
strSQLReg = "SELECT Keyno " _
& "FROM New_key_register AS Reg " _
& "LEFT JOIN (" & strSQLIssued & ") AS Iss " _
& "ON Reg.Keyno = Iss.NEWKEY " _
& "WHERE Iss.NEWKEY Is Null;"
'SQL for only members w/o keys for the given year.
strSQLIssued = strSQLIssued & " AND NEWKEY is null;"
Set db = CurrentDb
Set rsIssued = db.OpenRecordset(strSQLIssued, dbOpenDynaset)
With rsIssued
If Not (.BOF And .EOF) Then
'Get the available keys from New_key_register.
Set rsNew = db.OpenRecordset(strSQLReg, dbOpenDynaset)
If Not (rsNew.BOF And rsNew.EOF) Then
While (Not .EOF) And (Not rsNew.EOF)
.Edit
'Add this key to this member.
!NEWKEY = rsNew!Keyno
.Update
rsNew.MoveNext
.MoveNext
i = i + 1
Wend
End If
End If
End With
ExitHere:
On Error Resume Next
rsNew.Close
Set rsNew = Nothing
rsIssued.Close
Set rsIssued = Nothing
Set db = Nothing
IssuedKeys = i
On Error GoTo 0
Exit Function
ErrH:
MsgBox "Error: " & Err & vbCrLf & Err.Description, vbExclamation, "Bulk Issue"
Resume ExitHere
End Function
Take a look in attachment and let me know if I have missed something.
KeysRegister.zip
Cheers,
John