UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Code Causing An Infinite Loop, Access 2016    
 
   
lizba
post Sep 10 2019, 10:00 AM
Post#1



Posts: 263
Joined: 9-February 06
From: South Africa


Hi Guys
I have looked at my code and I cannot see what I have done wrong.

Please can someone spot my error:


Brief explanation of code :

It must loop through RSPRO for this client -

If CT = 1 then the system must create a task per month for the year - This works great
If CT = 2, then the system must create 1 task for the date 31st May of the current year - this goes into an infinite loop. pullhair.gif

My Code is ::

Dim db As DAO.Database
Dim RSPRO As DAO.Recordset
Dim rsTask As DAO.Recordset
Dim CT As Long
Dim Cus As Long
Dim StrTtl As String
Dim StrTl2 As String
Dim intDayCtr As Integer
Dim AnnDue As Date
Dim IntDue As Date


Set db = CurrentDb()

Set RSPRO = db.OpenRecordset("ClientCategoriesSel", dbOpenForwardOnly)



With RSPRO
Do While Not .EOF

Cus = Me.CustID
CT = !CatID
StrTtl = ![CategoryDescription]

If CT = 1 Then
Set rsTask = db.OpenRecordset("Cases", dbOpenDynaset)
For intDayCtr = 0 To DateDiff("m", ![CurrentYS], ![CurrentYE])

rsTask.AddNew
rsTask![CustCR] = Cus '
rsTask![Due Date] = DateAdd("m", intDayCtr, ![CurrentYS])
rsTask![CatCR] = CT
If Month(rsTask![Due Date]) > 9 Then
StrTl2 = Month(rsTask![Due Date])
Else
StrTl2 = "0" & Month(rsTask![Due Date])
End If
rsTask!Title = StrTtl & " " & StrTl2 & " " & Year(rsTask![Due Date])
rsTask.Update

Next
.MoveNext


rsTask.Close
Set rsTask = Nothing

ElseIf CT = 2 Then 'EMP501 - may Interim - October

AnnDue = DateSerial(Year(Date), 5, 31)
IntDue = DateSerial(Year(Date), 10, 31)


Set rstTsk = db.OpenRecordset("Cases", dbOpenDynaset)

rsTask.AddNew
rsTask!CatCR = CT
rsTask![Opened Date] = Date
rsTask![Due Date] = AnnDue
rsTask!CustCR = Cus
rsTask!Title = StrTtl

rsTask.Update
rsTask.Close
Set rsTask = Nothing


' Call CreateTask(Cus, StrTtl, CT, Date)
' Call CreateTask(Cus, StrTtl, CT, Date)

End If
Loop
End With
RSPRO.Close
Set RSPRO = Nothing


notworthy.gif

Go to the top of the page
 
JHolm
post Sep 10 2019, 10:07 AM
Post#2



Posts: 138
Joined: 7-July 15
From: BC Canada


You have forgotten to add a .MoveNext to the ElseIF section of your code.
Go to the top of the page
 
Kamulegeya
post Sep 10 2019, 10:08 AM
Post#3



Posts: 1,857
Joined: 5-September 10
From: Kampala,Uganda The Pearl of Africa


Hi lizba

I think there is no .movenext for the case CT=2.

Ronald
Go to the top of the page
 
projecttoday
post Sep 10 2019, 10:12 AM
Post#4


UtterAccess VIP
Posts: 11,073
Joined: 10-February 04
From: South Charleston, WV


.MoveNext should be moved right before Loop.

--------------------
Robert Crouser
Go to the top of the page
 
ADezii
post Sep 10 2019, 10:45 AM
Post#5



Posts: 2,679
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. Try to use Code Tags whenever possible for readability.
  2. Add an Else Clause within the If...ElseIf...End If Construct should CT<>1 AND CT<>2. I'm not sure if this is even possible, but I added a fall through Else just in cast.
  3. The only manner in which the Recordset will advance to the Next Record is if CT=1. Move the .MoveNext Line to after End If and before Loop.
  4. I have posted the modified Code, just keep in mind that some of it has intentionally been omitted.
    CODE
    Set db = CurrentDb()

    Set RSPRO = db.OpenRecordset("ClientCategoriesSel", dbOpenForwardOnly)

    With RSPRO
      Do While Not .EOF
        Cus = Me.CustID
        CT = !CatID
        StrTtl = ![CategoryDescription]

        If CT = 1 Then
          Set rsTask = db.OpenRecordset("Cases", dbOpenDynaset)
            For intDayCtr = 0 To DateDiff("m", ![CurrentYS], ![CurrentYE])
              rsTask.AddNew
                rsTask![CustCR] = Cus '
                rsTask![Due Date] = DateAdd("m", intDayCtr, ![CurrentYS])
                rsTask![CatCR] = CT
                  If Month(rsTask![Due Date]) > 9 Then
                    StrTl2 = Month(rsTask![Due Date])
                  Else
                    StrTl2 = "0" & Month(rsTask![Due Date])
                  End If
                rsTask!Title = StrTtl & " " & StrTl2 & " " & Year(rsTask![Due Date])
              rsTask.Update
            Next

            rsTask.Close
            Set rsTask = Nothing

        ElseIf CT = 2 Then 'EMP501 - may Interim - October
          AnnDue = DateSerial(Year(Date), 5, 31)
          IntDue = DateSerial(Year(Date), 10, 31)

          Set rstTsk = db.OpenRecordset("Cases", dbOpenDynaset)
          rsTask.AddNew
            rsTask!CatCR = CT
            rsTask![Opened Date] = Date
            rsTask![Due Date] = AnnDue
            rsTask!CustCR = Cus
            rsTask!Title = StrTtl
          rsTask.Update

          rsTask.Close
          Set rsTask = Nothing
        Else
          'contingency if CT<>1 and CT<>2, if possible at all
        End If
        .MoveNext
      Loop
    End With
Go to the top of the page
 
lizba
post Sep 22 2019, 09:00 AM
Post#6



Posts: 263
Joined: 9-February 06
From: South Africa


Thanks for the input - You were all spot on!
notworthy.gif
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    19th October 2019 - 12:54 PM