Doevents doesnt work ?
Need some helps on the following code below. The VB6 screen hang when I click on any program on the status bar. I do a Ctrl_Alt_Del into the Task Manger. VB6 program is 'Not Responding'.
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim strsql1 As String
Dim strsql2 As string
If GetInputState <> 0 Then DoEvents
If openCN(cn) Then
strsql1 = "select * from Tbl_Day"
If openRS(strsql, cn, rs1) Then
If Not rs1.EOF Then
rs1.MoveFirst
While Not rs1.EOF
strsql2 = "select * from Tbl_Week Where Day_ID='" & rs1.Fields("Day_ID") & "'"
If openRS(strsql2, cn, rs2) Then
If Not rs2.EOF Then
......
......
End if
Endif
Call CloseRs(rs2)
rs1.Movenext
wend
call CloseRs(rs1)
End if
End if
Call CloseCn(cn)
TIA!
[1192 byte] By [
OCT] at [2007-11-19 19:58:01]

# 1 Re: Doevents doesnt work ?
You could press F9 on any line to create a break point (after the DIM). Then press F8 to step thru the code one line at a time. You can hover over each field to see it's value in intellisense, or type ? VarName in the debug window to get it's value. You should be able to see where it's hanging, if it doesn't ever exit your while loop.
Your DoEvents only executes once, at the start of your routine. You want it to execute more often, but not until you find out that you don't have an endless loop. Maybe once for each i100 terations of rs1, maybe more than that.
Also, please use CodeTags. Highlight your code in the first post, and click the # icon.
# 2 Re: Doevents doesnt work ?
Thank you very much for your advise.
The code I posted is working fine without much problem. However if user started to click other programs on the status bar while it is running, the program hang!
suggestions to improve the coding method is very much welcomed.
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim strsql1 As String
Dim strsql2 As string
If GetInputState <> 0 Then DoEvents
If openCN(cn) Then
strsql1 = "select * from Tbl_Day"
If openRS(strsql1, cn, rs1) Then
If Not rs1.EOF Then
rs1.MoveFirst
While Not rs1.EOF
strsql2 = "select * from Tbl_Week Where Day_ID='" & rs1.Fields("Day_ID") & "'"
If openRS(strsql2, cn, rs2) Then
If Not rs2.EOF Then
......
......
End if
Endif
Call CloseRs(rs2)
rs1.Movenext
wend
call CloseRs(rs1)
End if
End if
Call CloseCn(cn)
OCT at 2007-11-9 20:11:40 >

# 3 Re: Doevents doesnt work ?
Try this first. If it works, add a counter so you can keep track of each row of the table. Then use
if x mod 10 = 0 then DoEvents ' which will execute every 10th time
if it still works, try increasing to 50, then 100. Get to the point where it hangs.
Call CloseRs(rs2)
DoEvents ' this will execute once for every record
rs1.Movenext
too many DoEvents will actually slow down your app, so you want as few as possible so that the app doesn't hang up other events that fire.
# 4 Re: Doevents doesnt work ?
Hi,
Below code work fine for me. Again thank you very much for the helps.
Best regards
CT
Call CloseRs(rs2)
DoEvents ' this will execute once for every record
rs1.Movenext
OCT at 2007-11-9 20:13:37 >

# 5 Re: Doevents doesnt work ?
Good. Now try it using less DoEvents statements. :wave:
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim strsql1 As String
Dim strsql2 As string
Dim x as long
' other code here
x=x+1
If x mod 100 = 0 then DoEvents
rs1.Movenext
wend
call CloseRs(rs1)
End if
End if
Call CloseCn(cn)