100% CPU Usage + "This action will reset...."

[PeteCresswell]

I'm working on a new report in an MS Access DB.

The first anomaly was a message "This action will reset the current
code in break mode." when the report was run. Seems TB something
about my Detail1_Print() : if I answer "No" to the dialog the report
just runs. If I answer "Yes", it pops a new dialog seemingly at every
line. Code is below.

The real zinger, however, started on Friday. When I run the report
in question somehow MS Access just keeps on running - using 100% of
the CPU according to TaskMan.

Anybody seen anything like this?
Here is the report's entire module. Note that the "reset" dialog
keeps popping, so I guess it's nothing to do with Report_Open()

I'm thinking Detail1_Print() . OTOH, Detail1_Print() 's code is
something that I frequently clone from report-to-report and hasn't
given me any trouble to date.
----------------------------------------------------
Option Compare Database
Option Explicit

Dim mNoInput As Boolean

Private Sub Detail_Print(Ca ncel As Integer, PrintCount As Integer)
1000 debugStackPush Me.Name & ": Detail_Print"
1001 On Error GoTo Detail_Print_er r

' PURPOSE: - To notify user gracefully if there are no records to
list
' - To alternate shading of lines - giving a greybar
effect

1002 Static prvWhatever As String
Static wantShading As Integer ' Shade this row or not?

Const COLOR_SHADE = &HE8E8E8
Const DS_INVISIBLE = 5

Const expressionHasNo Value = 2427

1010 With Me
1011 If mNoInput = True Then
1012 .txtNoInput.Vis ible = True
1013 Cancel = True
1019 Else
1020 If .txtCusip <> prvWhatever Then
1021 wantShading = Not wantShading 'Alternate the
value of wantShading
1029 End If

1030 If wantShading Then
1031 .DrawStyle = DS_INVISIBLE
1032 Me.Line (.txtCusip.Left , 0)-(.Width,
..Section(0).He ight), COLOR_SHADE, BF
1033 End If
1034 prvWhatever = .txtCusip
1039 End If
1999 End With

Detail_Print_xi t:
debugStackPop
On Error Resume Next
Exit Sub

Detail_Print_er r:
bugAlert True, ""
Resume Detail_Print_xi t
End Sub

Private Sub Report_NoData(C ancel As Integer)
debugStackPush Me.Name & ": Report_Open"
On Error GoTo Report_Open_err

mNoInput = True

Report_Open_xit :
debugStackPop
On Error Resume Next
Exit Sub

Report_Open_err :
bugAlert True, ""
Resume Report_Open_xit
End Sub

Private Sub Report_Open(Can cel As Integer)
1000 debugStackPush Me.Name & ": Report_Open"
1001 On Error GoTo Report_Open_err

' PURPOSE: - To prevent opening the report if any held
tblCusip.Deriva tive=True are
' missing from Jack's spreadsheet or have missing
values on same
' - To solicit the "As-Of" date TB printed in the report's
header

1002 Dim myRS As DAO.Recordset
Dim myDate As Control

Const ssPath_Missing = "C:\Tob_Missing .xls"
Const ssPath_ZeroOrNu ll = "C:\Tob_ZeroOrN ull.xls"
Const queryName_Missi ng =
"qryTobMaxRate_ Cusips_Spreadsh eetMissing"
Const queryName_ZeroO rNull =
"qryTobMaxRate_ Cusips_Spreadsh eetZeroOrNull"

1003 DoCmd.Hourglass True
1009 StatusSet "Validating spreadsheet input..."

1010 Set myRS = CurrentDb().Ope nRecordset(quer yName_Missing,
dbOpenSnapshot, dbForwardOnly)
1011 With myRS
1012 If Not ((.BOF = True) And (.EOF = True)) Then
1013 DoCmd.OutputTo acOutputQuery, queryName_Missi ng, "Microsoft
Excel (*.xls)", ssPath_Missing
1014 MsgBox "One or more held securities are missing from the
TobMaxRates spreadsheet." & vbCrLf & "Please contact an analyst and
have them added before trying to rerun." & vbCrLf & vbCrLf & "A list
of missing securities has been created in '" & ssPath_Missing & "'.",
vbCritical, "Cannot Open Report"
1015 Cancel = True
1016 End If
1017 .Close
1019 End With

1020 Set myRS = CurrentDb().Ope nRecordset(quer yName_ZeroOrNul l,
dbOpenSnapshot, dbForwardOnly)
1021 With myRS
1022 If Not ((.BOF = True) And (.EOF = True)) Then
1023 DoCmd.OutputTo acOutputQuery, queryName_ZeroO rNull,
"Microsoft Excel (*.xls)", ssPath_ZeroOrNu ll
1024 MsgBox "One or more securities on the TobMaxRates
spreadsheet have a MaxRate value that is zero or missing altogether."
& vbCrLf & "Please contact an analyst and have values added before
trying to rerun." & vbCrLf & vbCrLf & "A list of missing securities
has been created in '" & ssPath_ZeroOrNu ll & "'.", vbCritical, "Cannot
Open Report"
1025 Cancel = True
1026 End If
1027 .Close
1029 End With

1030 StatusSet ""

1040 If Cancel = False Then
1041 If productionModeG et() = False Then
1042 Me!txtTestingBa nner.Visible = True
1049 End If

1050 With DoCmd
1051 .OpenForm "frmGetDate ", , , , , acDialog, Me.Name
'Code pauses here until user closes frmGetDate
1052 .Hourglass False
1053 Set myDate = Forms!frmHome!t xtBeginDate
1054 If Val(myDate.Valu e & "") = 0 Then
'User cancelled out of date solicitation dialog
1055 Cancel = True
1056 Else
1057 Me.txtReportHea der.ControlSour ce = "=" & Chr$(34) &
"Tender Option Bonds/Max Rates As Of: " & Format$(myDate. Value,
"yyyy/mm/dd") & Chr$(34)
1058 End If
1059 End With
1999 End If

Report_Open_xit :
debugStackPop
On Error Resume Next
myRS.Close
Set myRS = Nothing
Exit Sub

Report_Open_err :
bugAlert True, ""
Resume Report_Open_xit
End Sub
----------------------------------------------------

[Doug Hutcheson]

Pete,

Wild guess #1: is the implicit test causing a problem (vague recollection
from A97 days)?

Wild guess #2: try explicitly closing and setting to 'Nothing' your DAO
objects when you have finished with them, in reverse of the order they were
created.

Wild guess #3: references issue - DAO vs ADO - in which order are they
declared?

Just my $0.02
Doug

--
Remove the blots from my address to reply
"PeteCressw ell" <Go**********@F atBelly.com> wrote in message
news:74******** *************** **@posting.goog le.com...
<snip>

Static wantShading As Integer ' Shade this row or not? <snip>

Doug***Not initialised - but why would that make a difference***
1021 wantShading = Not wantShading 'Alternate the value
<snip>

Doug***This is the implicit test I am wondering about*** 1030 If wantShading Then <snip> ----------------------------------------------------