This is the code I use to make a leave table, but if there are no records to create I get the run time error 3021.
Sub MakeLeaveTable()
'* This VBA code is Copyright by Christopher Mead, [www.MeadInKent.co.uk 2008]
'* Update the LeaveTable with new values of leave bookings
Dim MyDB As Database, LData As Recordset, LTable As Recordset, Temp As String, LUsers As Recordset
Dim MyMon As Integer, MyYear As Integer, NumMonths As Integer, MyDate As Date, LastDayOfMonth As Integer
Dim Specials As Recordset
Set MyDB = CurrentDb()
Set LData = MyDB.OpenRecordset("leavedata", dbOpenDynaset)
Set LUsers = MyDB.OpenRecordset("users", dbOpenDynaset)
Set LTable = MyDB.OpenRecordset("leavetable", dbOpenDynaset)
Set Specials = MyDB.OpenRecordset("specialdates", dbOpenDynaset)
'Temp = Format(Date, "MMYY")
'Temp = InputBox("Start period (MMYY)", "MakeLeaveTable()", Temp)
Debug.Print Val(Forms("compiledata").Controls("f_periodfrommm" ).Value)
Debug.Print Val(Forms("compiledata").Controls("f_periodfromyyy y").Value) - 2000
Debug.Print Val(Forms("compiledata").Controls("f_nummonths").V alue)
MyMon = Val(Forms("compiledata").Controls("f_periodfrommm" ).Value)
MyYear = Val(Forms("compiledata").Controls("f_periodfromyyy y").Value) - 2000
NumMonths = Val(Forms("compiledata").Controls("f_nummonths").V alue)
If NumMonths <> 0 Then
Debug.Print "ok"
Forms("compiledata").Controls("f_progress").Value = "2. Compiling table ..."
DoCmd.Hourglass True
For m = MyMon To MyMon + NumMonths - 1
'Debug.Print
'Debug.Print "Mon " & m & " > "
LastDayOfMonth = Day(DateSerial(2000 + MyYear, m + 1, 1) - 1)
LUsers.MoveFirst
Do While Not LUsers.EOF
If LUsers!UActive = "Y" Then
Debug.Print
Debug.Print LUsers!UName;
LTable.AddNew
LTable!tmonth = Month(DateSerial(2000 + MyYear, m, 1))
LTable!tyear = Year(DateSerial(2000 + MyYear, m, 1))
LTable!tsortby = LUsers!USortBy & LUsers!UName
LTable!tname = LUsers!UName
LTable!tshading = LUsers!UDeptShading
For d = 1 To 31
If d > LastDayOfMonth Then
Temp = "-"
Else
MyDate = DateSerial(2000 + MyYear, m, d)
If Weekday(MyDate, vbMonday) < 6 Then
LData.MoveFirst
Temp = "."
Do While Not LData.EOF
If LUsers!UInits = LData!LInits Then
If MyDate >= LData!LDateFrom And MyDate <= LData!LDateTo Then
Temp = LData!LType
Exit Do
End If
End If
LData.MoveNext
Loop
Else
Temp = "W"
End If
End If
Specials.MoveFirst ' check if current date is in specials table
Do While Not Specials.EOF
If MyDate = Specials!xdate Then
Temp = "X"
Exit Do
End If
Specials.MoveNext
Loop
'Debug.Print Temp;
LTable.Fields("t" & Format(d, "00")) = Temp ' set field for date to any reason code
Next d ' day
LTable.Update
End If ' if user is active
LUsers.MoveNext
Loop
Next m ' month
DoCmd.Hourglass False
End If ' OK button selected
LData.Close
LTable.Close
LUsers.Close
Specials.Close
Forms("compiledata").Controls("f_progress").Value = "3. Done ..."
End Sub
How can I trap there and print a message to the user to let them know there are no records?