S
Stu
Please can someone tell me what's wrong with the following code. It
seems to get stuck in a loop as it's updating the first record. Also
can someone please tell me how to initialise the date variable
AgDelDate as ="" doesn't work. The loop seems to stick on the
docmd.runsql line but I've tested the SQL and it works.
TIA
Stu
On Error GoTo Err_cmdUpdate_Click:
Dim db As Database
Dim rstSTA As dao.Recordset
Dim strUpdateStillages As String
Dim WO As String
Dim Dest As String
Dim AgDelDate As Date
Dim Project As String
Dim Still As String
Set db = CurrentDb
Set rstSTA = db.OpenRecordset("tblStillageAllocation")
DoCmd.SetWarnings False
If rstSTA.RecordCount > 0 Then
Do Until rstSTA.EOF
rstSTA.MoveFirst
Still = rstSTA.Fields("StillageNumber").Value
Dest = rstSTA.Fields("Destination").Value
WO = rstSTA.Fields("WONumber").Value
AgDelDate = rstSTA.Fields("AgreedDeliveryDate").Value
Project = rstSTA.Fields("Project").Value
StatusBar ("Updating stillage " & Still)
strUpdateStillages = "UPDATE tblStillages SET
tblStillages.Destination = '" & Dest & "',
tblStillages.WorksOrderNumber " _
& "= '" & WO & "', tblStillages.Project = '" & Project & "',
tblStillages.AgreedDeliveryDate = #" & AgDelDate _
& "#, tblStillages.Available = False WHERE
((tblStillages.StillageNumber)= '" & Still & "');"
DoCmd.RunSQL (strUpdateStillages)
Still = ""
Dest = ""
WO = ""
'AgDelDate = Null
Project = ""
rstSTA.MoveNext
Loop
rstSTA.Close
MsgBox ("Stillages Allocated")
Else
MsgBox ("No records to process")
End If
StatusBar ("")
DoCmd.SetWarnings True
Exit_cmdUpdate_Click:
Exit Sub
Err_cmdUpdate_Click:
StatusBar ("")
Dim strUnlockForm As String
strUnlockForm = "Update tblOpenForms set AlreadyOpen = False where
FormName = """ & "frmStillageAllocation" & """;"
DoCmd.RunSQL (strUnlockForm)
MsgBox Err.DESCRIPTION
Resume Exit_cmdUpdate_Click
End Sub
seems to get stuck in a loop as it's updating the first record. Also
can someone please tell me how to initialise the date variable
AgDelDate as ="" doesn't work. The loop seems to stick on the
docmd.runsql line but I've tested the SQL and it works.
TIA
Stu
On Error GoTo Err_cmdUpdate_Click:
Dim db As Database
Dim rstSTA As dao.Recordset
Dim strUpdateStillages As String
Dim WO As String
Dim Dest As String
Dim AgDelDate As Date
Dim Project As String
Dim Still As String
Set db = CurrentDb
Set rstSTA = db.OpenRecordset("tblStillageAllocation")
DoCmd.SetWarnings False
If rstSTA.RecordCount > 0 Then
Do Until rstSTA.EOF
rstSTA.MoveFirst
Still = rstSTA.Fields("StillageNumber").Value
Dest = rstSTA.Fields("Destination").Value
WO = rstSTA.Fields("WONumber").Value
AgDelDate = rstSTA.Fields("AgreedDeliveryDate").Value
Project = rstSTA.Fields("Project").Value
StatusBar ("Updating stillage " & Still)
strUpdateStillages = "UPDATE tblStillages SET
tblStillages.Destination = '" & Dest & "',
tblStillages.WorksOrderNumber " _
& "= '" & WO & "', tblStillages.Project = '" & Project & "',
tblStillages.AgreedDeliveryDate = #" & AgDelDate _
& "#, tblStillages.Available = False WHERE
((tblStillages.StillageNumber)= '" & Still & "');"
DoCmd.RunSQL (strUpdateStillages)
Still = ""
Dest = ""
WO = ""
'AgDelDate = Null
Project = ""
rstSTA.MoveNext
Loop
rstSTA.Close
MsgBox ("Stillages Allocated")
Else
MsgBox ("No records to process")
End If
StatusBar ("")
DoCmd.SetWarnings True
Exit_cmdUpdate_Click:
Exit Sub
Err_cmdUpdate_Click:
StatusBar ("")
Dim strUnlockForm As String
strUnlockForm = "Update tblOpenForms set AlreadyOpen = False where
FormName = """ & "frmStillageAllocation" & """;"
DoCmd.RunSQL (strUnlockForm)
MsgBox Err.DESCRIPTION
Resume Exit_cmdUpdate_Click
End Sub