By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,665 Members | 1,373 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,665 IT Pros & Developers. It's quick & easy.

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

P: n/a
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(Cancel As Integer, PrintCount As Integer)
1000 debugStackPush Me.Name & ": Detail_Print"
1001 On Error GoTo Detail_Print_err

' 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 expressionHasNoValue = 2427

1010 With Me
1011 If mNoInput = True Then
1012 .txtNoInput.Visible = 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).Height), COLOR_SHADE, BF
1033 End If
1034 prvWhatever = .txtCusip
1039 End If
1999 End With

Detail_Print_xit:
debugStackPop
On Error Resume Next
Exit Sub

Detail_Print_err:
bugAlert True, ""
Resume Detail_Print_xit
End Sub

Private Sub Report_NoData(Cancel 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(Cancel 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.Derivative=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_ZeroOrNull = "C:\Tob_ZeroOrNull.xls"
Const queryName_Missing =
"qryTobMaxRate_Cusips_SpreadsheetMissing"
Const queryName_ZeroOrNull =
"qryTobMaxRate_Cusips_SpreadsheetZeroOrNull"

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

1010 Set myRS = CurrentDb().OpenRecordset(queryName_Missing,
dbOpenSnapshot, dbForwardOnly)
1011 With myRS
1012 If Not ((.BOF = True) And (.EOF = True)) Then
1013 DoCmd.OutputTo acOutputQuery, queryName_Missing, "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().OpenRecordset(queryName_ZeroOrNull,
dbOpenSnapshot, dbForwardOnly)
1021 With myRS
1022 If Not ((.BOF = True) And (.EOF = True)) Then
1023 DoCmd.OutputTo acOutputQuery, queryName_ZeroOrNull,
"Microsoft Excel (*.xls)", ssPath_ZeroOrNull
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_ZeroOrNull & "'.", vbCritical, "Cannot
Open Report"
1025 Cancel = True
1026 End If
1027 .Close
1029 End With

1030 StatusSet ""

1040 If Cancel = False Then
1041 If productionModeGet() = False Then
1042 Me!txtTestingBanner.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!txtBeginDate
1054 If Val(myDate.Value & "") = 0 Then
'User cancelled out of date solicitation dialog
1055 Cancel = True
1056 Else
1057 Me.txtReportHeader.ControlSource = "=" & 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
----------------------------------------------------
Nov 13 '05 #1
Share this Question
Share on Google+
1 Reply


P: n/a
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
"PeteCresswell" <Go**********@FatBelly.com> wrote in message
news:74*************************@posting.google.co m...
<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> ----------------------------------------------------

Nov 13 '05 #2

This discussion thread is closed

Replies have been disabled for this discussion.