Missing something obvious (1 Viewer)

Malcy

Registered User.
Local time
Today, 05:27
Joined
Mar 25, 2003
Messages
586
Hi. I am having to make changes to an older db and decided to upgrade from ADO to DAO whilst I was at it (it made sense at the time). I am building a summary table to run a series of forms and reports. I know it is not the best way but it has worked.
I append the employees to the table then run through updating the various fields specific to each employee.
My code is falling over when it tries to identify the employee ID in almost the first line. When I step through it is trying to give an lngEmpId value of 0.
The code is
Code:
' Update the fields in tblReporting - need to sort!!!!
    rstRep.MoveFirst
        Do While rstRep.EOF = False
        lngEmp = rstRep!lngEmpId
            rstRep.Edit
                rstRep!dtmRptStart = Me.txtRptStart
                rstRep!dtmRptEnd = Me.txtRptEnd
                rstRep!dblHolAllowance = DLookup("dblEmpHolAl", "tblStaff", "[lngEmpId]= " & lngEmp & "")
                etc etc
 
            rstRep.Update
            rstRep.MoveNext
        Loop
Checking through code the variable is dimensioned and the recordset nomination is OK
Can anyone spot what I am being stupid about. Seem to have hit a blind spot!!
Thanks
 

Rabbie

Super Moderator
Local time
Today, 05:27
Joined
Jul 10, 2007
Messages
5,906
Can you post the code where you open the recordset. Nothing jumps off the page as being wrong so seeing more of the code may make it easier to spot the error.
 

Malcy

Registered User.
Local time
Today, 05:27
Joined
Mar 25, 2003
Messages
586
OK
Here is the whole sub. I know I am going to kick myself here!!!

Code:
Private Sub cmdRptDatesOk_Click()
On Error GoTo Err_cmdRptDatesOk_Click
    Dim dbs As DAO.Database
    Dim rstRd As DAO.Recordset
    Dim rstRep As DAO.Recordset
    Dim strQryDef As String
    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim lngEmp As Long
    Dim dtmMaxCal As Date
    
' Identify maximum date in tblCalendar
    dtmMaxCal = DMax("[dtmCalDate]", "tblCalendar")
    
' Set the connection
    Set dbs = CurrentDb
    Set rstRd = dbs.OpenRecordset("tblReportingDates")
    Set rstRep = dbs.OpenRecordset("tblReporting")
    
' Verify that critical fields have valid entries
    If IsNull(Me.txtRptStart) Or Me.txtRptStart = "" Then
        MsgBox "You must enter the start date for the report.", vbOKOnly, "Data required"
        Me.txtRptStart.SetFocus
        Exit Sub
    End If
   
    If IsNull(Me.txtRptEnd) Or Me.txtRptEnd = "" Then
        MsgBox "You must enter the end date for the report.", vbOKOnly, "Data required"
        Me.txtRptEnd.SetFocus
        Exit Sub
    End If
   
' Identify whether the dates are beyond the limit of the calendar
    If Me.txtRptStart > dtmMaxCal Then
        MsgBox "The date you have entered is not yet added to the calendar. Please check date.", vbOKOnly, "Data required"
        Me.txtRptStart.SetFocus
        Exit Sub
    End If
    
    If Me.txtRptEnd > dtmMaxCal Then
        MsgBox "The date you have entered is not yet added to the calendar. Please check date.", vbOKOnly, "Data required"
        Me.txtRptEnd.SetFocus
        Exit Sub
    End If
   
' Reveal wait message
    Me.lblWait.Visible = True
    Me.Repaint
    
' Clear down any hours in tblStaffDays where holidays are booked for a Public Holiday
    DoCmd.SetWarnings False
        strQryDef = "qupdSdPhHol"
            DoCmd.OpenQuery strQryDef
    DoCmd.SetWarnings True

' Clear down any hours in tblActual where holidays are booked for a Public Holiday
    DoCmd.SetWarnings False
        strQryDef = "qupdActualPhHol"
            DoCmd.OpenQuery strQryDef
    DoCmd.SetWarnings True

'' Mark up taken holidays
    DoCmd.SetWarnings False
        strQryDef = "qupdSdHolTak"
            DoCmd.OpenQuery strQryDef
    DoCmd.SetWarnings True

' Delete any extant records in tblTmpReportDates
    dbs.Execute "DELETE * FROM tblReportingDates"
    
' Update dates from this form to tblReportingDates
    rstRd.AddNew
        rstRd!dtmStart = Me.txtRptStart
        rstRd!dtmEnd = Me.txtRptEnd
    rstRd.Update
        
' Delete any extant records in tblReporting
    dbs.Execute "DELETE * FROM tblReporting"
    
' Update tblReporting so that all active employees are shown
    DoCmd.SetWarnings False
        strQryDef = "qappRptActStaff"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True

' Update the fields in tblReporting - need to sort!!!!
    rstRep.MoveFirst
        Do While rstRep.EOF = False
        lngEmp = rstRep!lngEmpId
            rstRep.Edit
                rstRep!dtmRptStart = Me.txtRptStart
                rstRep!dtmRptEnd = Me.txtRptEnd
                rstRep!dblHolAllowance = DLookup("dblEmpHolAl", "tblStaff", "[lngEmpId]= " & lngEmp & "")
                rstRep!dblHolServRel = DLookup("dblEmpSrHol", "tblStaff", "[lngEmpId]= " & lngEmp & "")
                rstRep!dblHolPubHol = DLookup("dblEmpPhHol", "tblStaff", "[lngEmpId]= " & lngEmp & "")
                rstRep!dblHolAll = DLookup("dblEmpHolAl", "tblStaff", "[lngEmpId]= " & lngEmp & "")
                rstRep!dblHolTak = DLookup("[SumHolTaken]", "qsumHolTaken", "[lngActEmp]= " & lngEmp & "")
                rstRep!dblHolBook = DLookup("[SumHolBook]", "qsumHolBooked", "[lngEmpNo]= " & lngEmp & "")
                rstRep!dblAuthAbs = DLookup("[SumAuthAbs]", "qsumAuthAbs", "[lngActEmp]= " & lngEmp & "")
                rstRep!dblAccTak = DLookup("[SumAccTaken]", "qsumAccTaken", "[lngActEmp]= " & lngEmp & "")
                rstRep!dblCol = DLookup("[SumColl]", "qsumColl", "[lngActEmp]= " & lngEmp & "")
                rstRep!dblIll = DLookup("[SumIll]", "qsumIll", "[lngActEmp]= " & lngEmp & "")
                rstRep!dblAcc = DLookup("[SumAccDue]", "qsumAccDue", "[lngActEmp]= " & lngEmp & "")
            rstRep.Update
            rstRep.MoveNext
        Loop
    
' Set all null values to 0 in tblReporting
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt1"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
    
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt2"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt3"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt4"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt5"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt6"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt7"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
        
    DoCmd.SetWarnings False
        strQryDef = "qupdRpt8"
            DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
    DoCmd.SetWarnings True
    
' Close the form
    stDocName = "frmReportingDates"
        DoCmd.Close acForm, stDocName, acSaveNo
    
' Open the form
    stDocName = "frmAttendance"
        DoCmd.OpenForm stDocName, , , stLinkCriteria
    
Exit_cmdRptDatesOk_Click:
    rstRd.Close
    rstRep.Close
    Set rstRd = Nothing
    Set rstRep = Nothing
    Set dbs = Nothing
    stDocName = vbNullString
    strQryDef = vbNullString
    Exit Sub

Err_cmdRptDatesOk_Click:
    MsgBox Err.Description
    Resume Exit_cmdRptDatesOk_Click
End Sub
 

Users who are viewing this thread

Top Bottom