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

Access Hangs in Task Manager - Need Expert Help!

P: n/a
I need serious help - I have a frontend/backend Access database (2 MDE Files)
that remains stuck in task manager after exiting the application - you can't
reopen database after exiting as a result - I have read every post out there
and spent hours trying to figure out the problem with no success whatsoever -
I have constrained the problem to one form however, and I think it's hiding
somewhere in my code associated with this form, which is long and tedious - I
have done all of the following:

1. All objects/recordsets opened in VBA are closed and pointers set =
Nothing
2. Checked my code for "boolean bug" - all code associated with checkboxes
is right
3. Imported all objects into a new database in case this was a corruption
issue
4. Checked and confirmed references (ie. not using ADO and DAO together
simultaneously)

Below is my code broken into two sections; first the code in class module
behind form, then the procedures/functions stored in a standard module which
are used/referenced from code behind form:

Also, this is a query-by-form search tool - this procedure builds a complex
SQL string in VBA based on user's selections from check boxes, multi-select
listboxes, textboxes, and combo-boxes, appends the results into a permanent
"results" table (after deleting prior results from same table), then exports
table into new Excel worksheet - the hang tends to occur after running just a
few searches in a short period of time and existing the application.

Private Sub cmdSearch_Click()

'Very first thing: Clear out any criteria strings stuck in memory
Call ClearSearchStrings

' Confirm that at least one criteria is selected
If CheckForCriteria = True Then
MsgBox "Please select at least one criteria to execute your search.",
vbCritical, _
"No Search Criteria Selected"
Exit Sub
End If

' Verify that Start Date is not later than End Date
If VerifyDates = True Then
MsgBox "Start date cannot be later than end date.", vbCritical, _
"Start Date End Date"
Exit Sub
End If

' Verify that Min Price is not greater than Max Price
If VerifyPrices = True Then
MsgBox "Min price cannot be greater than max price.", vbCritical, _
"Min Price Max Price"
Exit Sub
End If

' Verify that Min Rating is not greater than Max Rating
If VerifyRatings = True Then
MsgBox "Min rating cannot be greater than max rating.", vbCritical, _
"Min Rating Max Rating"
Exit Sub
End If

'Build search and criteria strings

' Check for errors in building search and criteria strings
If BuildSearchString(strFullString, strWineType, strVarietal, strVintage, _
strWineStyle, strReserve, strUnfiltered, strUnoaked, strStartDate, strEndDate,
_
strMinPrice, strMaxPrice, strMinRating, strMaxRating, strCountry, strState, _
strRegion, strAppellation) = False Then
MsgBox "There was a problem building the SQL string."
Exit Sub
End If

' Check for errors in building results table
If BuildResultsTable(strTruncate, strFullString, "zstblSearchResults",
lngRecordsAffected) = False Then
MsgBox "There was a problem building the search results table."
Exit Sub
End If

' Check for errors in displaying results
If DisplayResults(lngRecordsAffected) = False Then
MsgBox "There was a problem displaying the search results"
Exit Sub
End If

End Sub

'-----------------------------------------------------------------------------
-------------------------------------------------------------------

BELOW ARE PROCEDURES/FUNCTIONS REFERENCED FROM CODE ABOVE - ANY HELP/FEEDBACK
WOULD BE GREATLY APPRECIATED!!!

Option Compare Database
Option Explicit

Public strFullString As String
Public strTruncate As String
Public lngRecordsAffected As Long
Public strWineType As String
Public strVarietal As String
Public strVintage As String
Public strWineStyle As String
Public strReserve As String
Public strUnfiltered As String
Public strUnoaked As String
Public strStartDate As String
Public strEndDate As String
Public strMinPrice As String
Public strMaxPrice As String
Public strMinRating As String
Public strMaxRating As String
Public strCountry As String
Public strState As String
Public strRegion As String
Public strAppellation As String

Function BuildSearchString(strFullString As String, strWineType As String, _
strVarietal As String, strVintage As String, strWineStyle As String, _
strReserve As String, strUnfiltered As String, strUnoaked As String, _
strStartDate As String, strEndDate As String, strMinPrice As String, _
strMaxPrice As String, strMinRating As String, strMaxRating As String, _
strCountry As String, strState As String, strRegion As String, strAppellation
As String) As Boolean

On Error GoTo Err_BuildSearchString

'Declarations
Dim frm As Form
Dim strFrom As String
Dim strWhere As String
Dim strBuildString As String
Dim strBuildCriteria As String
Dim strDelim As String
Dim strChk As String
Dim boofirstflag As Boolean
Dim intSelItem As Variant

'Start building search string
'Set the SELECT statement
Const strSelect = "SELECT tblWineNotes.BottleID "

'Set the FROM statement based on which listboxes are used
'Choosing Country, State, Region or Appellation creates a right join with
tblWineMap table
'Const strFrom = "FROM tblGames " (this is no longer being used)
With Forms("frmReportsMain")
'Check to see if any of the geographical listboxes are being used
If .lboCountry.ItemsSelected.Count _
Or .lboState.ItemsSelected.Count _
Or .lboRegion.ItemsSelected.Count _
Or .lboAppellation.ItemsSelected.Count Then
strFrom = "FROM tblWineMap RIGHT JOIN tblWineNotes ON tblWineMap.
RegionID=tblWineNotes.RegionID "
Else
strFrom = "FROM tblWineNotes "
End If
End With

'Set the ORDER BY statement
Const strOrderBy = "ORDER BY tblWineNotes.TastingDate DESC;"

'Set the strDelim string
strDelim = """"

'Building the string now that we have strSelect and strFrom
strFullString = strSelect & strFrom

boofirstflag = False ' this flag shows whether a WHERE has yet been
added

Set frm = Forms("frmReportsMain")

' Search by WineType
If frm.lboWineType.ItemsSelected.Count Then
boofirstflag = True
strWhere = "WHERE tblWineNotes.WineTypeID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboWineType.ItemsSelected
strBuildString = strBuildString & "," & frm.lboWineType.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboWineType.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strWineType = "Wine Type: " & strBuildCriteria
Else
strWineType = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Varietal
If frm.lboVarietal.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.PrimaryGrapeID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboVarietal.ItemsSelected
strBuildString = strBuildString & "," & frm.lboVarietal.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboVarietal.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strVarietal = "Primary Varietal: " & strBuildCriteria
Else
strVarietal = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Vintage
If frm.lboVintage.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.VintageID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboVintage.ItemsSelected
strBuildString = strBuildString & "," & frm.lboVintage.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboVintage.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strVintage = "Vintage: " & strBuildCriteria
Else
strVintage = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by WineStyle
If frm.lboWineStyle.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.WineStyle In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboWineStyle.ItemsSelected
strBuildString = strBuildString & "," & strDelim & frm.
lboWineStyle.ItemData(intSelItem) & strDelim
strBuildCriteria = strBuildCriteria & ", " & frm.lboWineStyle.
Column(0, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strWineStyle = "Wine Style: " & strBuildCriteria
Else
strWineStyle = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Reserve
If frm.chkReserve.Value = -1 Or frm.chkReserve.Value = 0 Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.Reserve = " & frm.chkReserve.
Value & " "
Select Case frm.chkReserve

Case -1
strChk = "TRUE"
Case 0
strChk = "FALSE"
End Select

strReserve = "Reserve: " & strChk
Else
strReserve = ""
End If

' Search by Unfiltered
If frm.chkUnfiltered.Value = -1 Or frm.chkUnfiltered.Value = 0 Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.Unfiltered = " & frm.
chkUnfiltered.Value & " "
Select Case frm.chkUnfiltered

Case -1
strChk = "TRUE"
Case 0
strChk = "FALSE"
End Select

strUnfiltered = "Unfiltered: " & strChk
Else
strUnfiltered = ""
End If

' Search by Unoaked
If frm.chkUnoaked.Value = -1 Or frm.chkUnoaked.Value = 0 Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.Unoaked = " & frm.chkUnoaked.
Value & " "
Select Case frm.chkUnoaked

Case -1
strChk = "TRUE"
Case 0
strChk = "FALSE"
End Select

strUnoaked = "Unoaked: " & strChk
Else
strUnoaked = ""
End If

' Search by Start Date
If Not IsNull([frm].[txtStartDate]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.TastingDate >= " & "#" & Format((
[frm].[txtStartDate]), "mm/dd/yyyy") & "# "
strStartDate = "Start Date: " & Format(([frm].[txtStartDate]),
"mm/dd/yyyy")
Else
strStartDate = ""
End If

' Search End Date
If Not IsNull([frm].[txtEndDate]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.TastingDate <= " & "#" & Format((
[frm].[txtEndDate]), "mm/dd/yyyy") & "# "
strEndDate = "End Date: " & Format(([frm].[txtEndDate]), "mm/dd/yyyy")

Else
strEndDate = ""
End If

' Search by Min Price
If Not IsNull([frm].[txtMinPrice]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.Price >= " & ([frm].[txtMinPrice])
& " "
strMinPrice = "Min Price: " & Format(([frm].[txtMinPrice]), "$#,##0.
00")
Else
strMinPrice = ""
End If

' Search by Max Price
If Not IsNull([frm].[txtMaxPrice]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.Price <= " & ([frm].[txtMaxPrice])
& " "
strMaxPrice = "Max Price: " & Format(([frm].[txtMaxPrice]), "$#,##0.
00")
Else
strMaxPrice = ""
End If

' Search by Min Rating
If Not IsNull([frm].[txtMinRating]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.ScaleRating >= " & ([frm].
[txtMinRating]) & " "
strMinRating = "Min Rating: " & Format(([frm].[txtMinRating]), "0.00")

Else
strMinRating = ""
End If

' Search by Max Rating
If Not IsNull([frm].[txtMaxRating]) Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.ScaleRating <= " & ([frm].
[txtMaxRating]) & " "
strMaxRating = "Max Rating: " & Format(([frm].[txtMaxRating]), "0.00")

Else
strMaxRating = ""
End If

' Search by Country
If frm.lboCountry.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineMap.Country In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboCountry.ItemsSelected
strBuildString = strBuildString & "," & frm.lboCountry.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboCountry.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strCountry = "Country: " & strBuildCriteria
Else
strCountry = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by State
If frm.lboState.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineMap.State In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboState.ItemsSelected
strBuildString = strBuildString & "," & frm.lboState.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboState.Column
(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strState = "State: " & strBuildCriteria
Else
strState = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Region
If frm.lboRegion.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineMap.Region In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboRegion.ItemsSelected
strBuildString = strBuildString & "," & frm.lboRegion.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboRegion.Column
(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strRegion = "Region: " & strBuildCriteria
Else
strRegion = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Appellation
If frm.lboAppellation.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
End If
strWhere = strWhere & "tblWineMap.Appellation In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboAppellation.ItemsSelected
strBuildString = strBuildString & "," & frm.lboAppellation.
ItemData(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboAppellation.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strAppellation = "Appellation: " & strBuildCriteria
Else
strAppellation = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

'Search string components have been built
'So let's put them all together now...
strFullString = strFullString & strWhere & strOrderBy

BuildSearchString = True

Set intSelItem = Nothing
strChk = ""
strDelim = ""
strWhere = ""
strFrom = ""
Set frm = Nothing

Exit_BuildSearchString:
Exit Function

Err_BuildSearchString:
MsgBox Err.Description
Resume Exit_BuildSearchString

End Function

Function BuildResultsTable(strTruncate As String, strFullString As String, _
strTableName As String, lngRecordsAffected As Long) As Boolean

Dim db As DAO.Database
Dim qdfAppend As DAO.QueryDef
Dim qdfTruncate As DAO.QueryDef

Set db = CurrentDb()

'Delete previous search results before appending new search results to
tblSearchResults table
strTruncate = "DELETE [zstblSearchResults].[Unicode] FROM
zstblSearchResults;"

On Error Resume Next
Set qdfTruncate = db.CreateQueryDef("", strTruncate)
qdfTruncate.Execute dbFailOnError
qdfTruncate.Close
On Error GoTo 0

'Append new search results
strFullString = "INSERT INTO " & strTableName & " " & strFullString
Set qdfAppend = db.CreateQueryDef("", strFullString)
qdfAppend.Execute dbFailOnError
lngRecordsAffected = qdfAppend.RecordsAffected
qdfAppend.Close

BuildResultsTable = True

Set qdfTruncate = Nothing
Set qdfAppend = Nothing
Set db = Nothing

End Function

Function DisplayResults(lngRecordsAffected As Long) As Boolean

'Declarations
Dim frm As Form
Dim intReturn As Integer
Dim strMsg As String
Dim strRpt As String
Dim strQueryName As String
Dim strSheetName As String
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlSheet2 As Excel.Worksheet
Dim xlRange As Excel.Range
Dim objRST As DAO.Recordset
Dim fld As DAO.Field
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim critVar As Variant
Dim CriteriaGroup(1 To 17) As String

Set frm = Forms("frmReportsMain")

Select Case lngRecordsAffected
Case 0
strMsg = "No wines matched the criteria you specified."
MsgBox strMsg, vbExclamation, Application.Name
DisplayResults = True
Exit Function
Case 1
strMsg = "Your search returned 1 wine."
strMsg = strMsg & vbCrLf & vbCrLf & "Would you like to proceed?"
Case Is 1
strMsg = "Your search returned " & lngRecordsAffected & " wines."
strMsg = strMsg & vbCrLf & vbCrLf & "Would you like to proceed?"
End Select

intReturn = MsgBox(strMsg, _
vbQuestion + vbYesNo + vbDefaultButton1, _
Application.Name)

If intReturn = vbYes Then

'Declare string parameters to insert into reusable procedure...
Select Case frm.cboReportType

Case 1

strRpt = ""
strQueryName = "qryWinesAtAGlanceRpt"
strSheetName = "Wines at a Glance"

Case 2

strRpt = ""
strQueryName = "qryWineListRpt"
strSheetName = "Wine List"

Case 3

strRpt = ""
strQueryName = "qryBlendRpt"
strSheetName = "Blend Report"

Case 4

strRpt = ""
strQueryName = "qryProducerListRpt"
strSheetName = "Producer List"

End Select

'Run report depending on format selecttion...
Select Case frm.cboFormatType

Case 1

'DoCmd.OpenForm strRpt, acNormal

Case 2

DoCmd.Hourglass True

CriteriaGroup(1) = strWineType
CriteriaGroup(2) = strVarietal
CriteriaGroup(3) = strVintage
CriteriaGroup(4) = strWineStyle
CriteriaGroup(5) = strReserve
CriteriaGroup(6) = strUnfiltered
CriteriaGroup(7) = strUnoaked
CriteriaGroup(8) = strStartDate
CriteriaGroup(9) = strEndDate
CriteriaGroup(10) = strMinPrice
CriteriaGroup(11) = strMaxPrice
CriteriaGroup(12) = strMinRating
CriteriaGroup(13) = strMaxRating
CriteriaGroup(14) = strCountry
CriteriaGroup(15) = strState
CriteriaGroup(16) = strRegion
CriteriaGroup(17) = strAppellation

'First, we need to build criteria strings and insert them into Excel

'Set xlApp = CreateObject("Excel.Application")
Set xlApp = New Excel.Application
Set xlWorkbook = xlApp.Workbooks.Add
Set xlSheet = xlWorkbook.Worksheets.Add

With xlSheet.Cells(1, 1)
.Value = "Search Criteria Selected:"
.Font.Bold = True
End With

x = 3

For Each critVar In CriteriaGroup
If critVar <"" Then
With xlSheet
.Cells(x, 1).Value = critVar
End With
x = x + 1
End If
Next critVar

xlSheet.Columns.AutoFit
xlSheet.Name = "Search Criteria"

'Now that we have criteria built into worksheet,
'we need to export the actual data that matched criteria

'BEGINNING OF ORIGINAL CODE...

Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)

Set xlSheet2 = xlWorkbook.Worksheets.Add
'Set xlSheet = xlWorkbook.Sheets.Add
'Set xlSheet = xlWorkbook.Sheets.(1)
y = 1
For Each fld In objRST.Fields
With xlSheet2
.Cells(1, y).Value = fld.Name
.Cells(1, y).Font.Bold = True
End With
y = y + 1
Next fld
Set xlRange = xlSheet2.Cells(2, 1)
xlRange.CopyFromRecordset objRST
xlSheet2.Name = strSheetName 'Or just create a straight forward name
surrounded by double quotes like a string
xlSheet2.Columns.AutoFit
objRST.Close

'Run some customized formatting depending on report type...
Select Case frm.cboReportType

Case 1

Set xlRange = xlSheet2.Columns("T:T")
xlRange.NumberFormat = "$#,##0.00"
Set xlRange = xlSheet2.Columns("AD:AD")
xlRange.NumberFormat = "0.0%"
Set xlRange = xlSheet2.Columns("AF:AF")
xlRange.NumberFormat = "0.00"
Set xlRange = xlSheet2.Columns("AJ:AJ")
xlRange.NumberFormat = "0.00"
Set xlRange = xlSheet2.Columns("AK:AK")
xlRange.NumberFormat = "0.00"
Set xlRange = xlSheet2.Columns("AL:AL")
xlRange.NumberFormat = "0.00"
Set xlRange = xlSheet2.Columns("AM:AM")
xlRange.NumberFormat = "0.0"

Case 2

Set xlRange = xlSheet2.Columns("E:E")
xlRange.NumberFormat = "$#,##0.00"
Set xlRange = xlSheet2.Columns("F:F")
xlRange.NumberFormat = "0.00"

Case 3

Case 4

Set xlRange = xlSheet2.Columns("C:D")
xlRange.NumberFormat = "[<=9999999]###-####;(###) ###-####"

End Select

xlApp.Visible = True

DoCmd.Hourglass False

End Select

End If

'Previous code for clearing out hanging criteria strings was located here...
'Run clear procedure again to clear up some memory...
Call ClearSearchStrings

Set frm = Nothing
Erase CriteriaGroup()
Set critVar = Nothing
Set fld = Nothing
Set objRST = Nothing
Set xlRange = Nothing
Set xlSheet2 = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

DisplayResults = True

End Function

--
Message posted via http://www.accessmonster.com

Apr 18 '07 #1
Share this Question
Share on Google+
9 Replies


P: n/a
"pic078 via AccessMonster.com" <u15923@uwewrote in message
news:70dee075d494a@uwe...

How are you closing the application?

Keith.
www.keithwilby.com
Apr 18 '07 #2

P: n/a
Command button - DoCmd.Quit on click event - I created the button using the
wizard to save some time writing code, then I modified it to close some
preloaded forms which are in hidden state - I designed the application with
this type of exit button on three to four forms (only one of which can be
visible/open at any given point in time - I made sure all of my preloaded
hidden forms are closed prior to exiting...in essence, the user can exit
application from the search form, or close the search form and exit from the
main menu/switchboard form. I have opened/closed application repetitively
using all of the exit buttons with no problems - seems like MSACCESS.EXE only
hangs when I run the code/procedures above several times prior to exiting -
there is one function above which returns 18 string variables - even then, I
make sure I set all string values = "" to retain whatever memory I can.

I did read an earlier post noting there is a difference between using DoCmd.
Quit and Application.Quit...I did not try this yet, and I don't think there
is reason to, since I have always used DoCmd.Quit in other similarly designed
databases I have built with no problems.

Let me know if you need more color...I need all the help I can get here.

Keith Wilby wrote:
>How are you closing the application?

Keith.
www.keithwilby.com
--
Message posted via http://www.accessmonster.com

Apr 18 '07 #3

P: n/a
"pic078 via AccessMonster.com" <u15923@uwewrote in message
news:70e3dd20d98f8@uwe...
Command button - DoCmd.Quit on click event -
Clutching at straws here but it might be worth looking at putting the Quit
command in a hidden form's Close event and have your buttons close the
hidden form. Not ever having encountered your problem I don't know if it
will help but it might be worth trying.

Regards,
Keith.
Apr 18 '07 #4

P: n/a
On Apr 18, 7:52 am, "Keith Wilby" <h...@there.comwrote:
"pic078 via AccessMonster.com" <u15923@uwewrote in messagenews:70e3dd20d98f8@uwe...
Command button - DoCmd.Quit on click event -

Clutching at straws here but it might be worth looking at putting the Quit
command in a hidden form's Close event and have your buttons close the
hidden form. Not ever having encountered your problem I don't know if it
will help but it might be worth trying.

Regards,
Keith.
With all the hours you've spent, why not try application.quit?
docmd.quit is provided for backward capability. Application.quit is
the currently recommended method (it says so in the help).

One other thing you might try (grasping at straws here too) is to use
the forms collection to close all open forms before exiting. By the
way - is the .ldb file still around? Can you delete it? If so, after
deleting it, can you open the application? I would expect you
could. I'm not sure what this would tell you, but it might be a
start.

Good luck,
Larry Engles

Apr 18 '07 #5

P: n/a
Thanks for your response Keith. I will try application.quit - the only
reason I have not is because I have another database set up the same way with
no problems.

I have looped through the forms collection - all forms are closed prior to
exiting.

The idb. file is still visible on desktop and CANNOT be deleted - you have to
go through task manager and delete the process before attempting to reopen or
reboot machine.

I think I may have found the problem in my BuildSearchString function (which
has to run each time a search is done on the form) - I have 17 arguments
which are not needed for the function to run! These should just be public
variables and set within this function rather than being required inputs for
function to process...this function actually builds those string variables,
so they can't be arguments prior to running that very same function. If you
look, I so declare those same 17 arguments as public variables, which may be
why all of my code runs without any error messages...

This could also just be another problem and not the solution...do functions
which carry a large number of arguments take up significant memory???
Especially if the arguments are not necessary?

I will have to wait until I get home from work to modify the code.



en****@ridesoft.com wrote:
Command button - DoCmd.Quit on click event -
[quoted text clipped - 5 lines]
>Regards,
Keith.

With all the hours you've spent, why not try application.quit?
docmd.quit is provided for backward capability. Application.quit is
the currently recommended method (it says so in the help).

One other thing you might try (grasping at straws here too) is to use
the forms collection to close all open forms before exiting. By the
way - is the .ldb file still around? Can you delete it? If so, after
deleting it, can you open the application? I would expect you
could. I'm not sure what this would tell you, but it might be a
start.

Good luck,
Larry Engles
--
Message posted via AccessMonster.com
http://www.accessmonster.com/Uwe/For...ccess/200704/1

Apr 18 '07 #6

P: n/a
Thanks Keith - good idea - I will try it out and let you know what happens.

Keith Wilby wrote:
>Command button - DoCmd.Quit on click event -

Clutching at straws here but it might be worth looking at putting the Quit
command in a hidden form's Close event and have your buttons close the
hidden form. Not ever having encountered your problem I don't know if it
will help but it might be worth trying.

Regards,
Keith.
--
Message posted via AccessMonster.com
http://www.accessmonster.com/Uwe/For...ccess/200704/1

Apr 18 '07 #7

P: n/a

it's really really really simple

don't listen to these DAO dorks.
use ADO and your nightmare goes away


On Apr 17, 9:41 pm, "pic078 via AccessMonster.com" <u15923@uwewrote:
I need serious help - I have a frontend/backend Access database (2 MDE Files)
that remains stuck in task manager after exiting the application - you can't
reopen database after exiting as a result - I have read every post out there
and spent hours trying to figure out the problem with no success whatsoever -
I have constrained the problem to one form however, and I think it's hiding
somewhere in my code associated with this form, which is long and tedious- I
have done all of the following:

1. All objects/recordsets opened in VBA are closed and pointers set =
Nothing
2. Checked my code for "boolean bug" - all code associated with checkboxes
is right
3. Imported all objects into a new database in case this was a corruption
issue
4. Checked and confirmed references (ie. not using ADO and DAO together
simultaneously)

Below is my code broken into two sections; first the code in class module
behind form, then the procedures/functions stored in a standard module which
are used/referenced from code behind form:

Also, this is a query-by-form search tool - this procedure builds a complex
SQL string in VBA based on user's selections from check boxes, multi-select
listboxes, textboxes, and combo-boxes, appends the results into a permanent
"results" table (after deleting prior results from same table), then exports
table into new Excel worksheet - the hang tends to occur after running just a
few searches in a short period of time and existing the application.

Private Sub cmdSearch_Click()

'Very first thing: Clear out any criteria strings stuck in memory
Call ClearSearchStrings

' Confirm that at least one criteria is selected
If CheckForCriteria = True Then
MsgBox "Please select at least one criteria to execute your search.",
vbCritical, _
"No Search Criteria Selected"
Exit Sub
End If

' Verify that Start Date is not later than End Date
If VerifyDates = True Then
MsgBox "Start date cannot be later than end date.", vbCritical, _
"Start Date End Date"
Exit Sub
End If

' Verify that Min Price is not greater than Max Price
If VerifyPrices = True Then
MsgBox "Min price cannot be greater than max price.", vbCritical, _
"Min Price Max Price"
Exit Sub
End If

' Verify that Min Rating is not greater than Max Rating
If VerifyRatings = True Then
MsgBox "Min rating cannot be greater than max rating.", vbCritical, _
"Min Rating Max Rating"
Exit Sub
End If

'Build search and criteria strings

' Check for errors in building search and criteria strings
If BuildSearchString(strFullString, strWineType, strVarietal, strVintage,_
strWineStyle, strReserve, strUnfiltered, strUnoaked, strStartDate, strEndDate,
_
strMinPrice, strMaxPrice, strMinRating, strMaxRating, strCountry, strState, _
strRegion, strAppellation) = False Then
MsgBox "There was a problem building the SQL string."
Exit Sub
End If

' Check for errors in building results table
If BuildResultsTable(strTruncate, strFullString, "zstblSearchResults",
lngRecordsAffected) = False Then
MsgBox "There was a problem building the search results table."
Exit Sub
End If

' Check for errors in displaying results
If DisplayResults(lngRecordsAffected) = False Then
MsgBox "There was a problem displaying the search results"
Exit Sub
End If

End Sub

'--------------------------------------------------------------------------*---
-------------------------------------------------------------------

BELOW ARE PROCEDURES/FUNCTIONS REFERENCED FROM CODE ABOVE - ANY HELP/FEEDBACK
WOULD BE GREATLY APPRECIATED!!!

Option Compare Database
Option Explicit

Public strFullString As String
Public strTruncate As String
Public lngRecordsAffected As Long
Public strWineType As String
Public strVarietal As String
Public strVintage As String
Public strWineStyle As String
Public strReserve As String
Public strUnfiltered As String
Public strUnoaked As String
Public strStartDate As String
Public strEndDate As String
Public strMinPrice As String
Public strMaxPrice As String
Public strMinRating As String
Public strMaxRating As String
Public strCountry As String
Public strState As String
Public strRegion As String
Public strAppellation As String

Function BuildSearchString(strFullString As String, strWineType As String, _
strVarietal As String, strVintage As String, strWineStyle As String, _
strReserve As String, strUnfiltered As String, strUnoaked As String, _
strStartDate As String, strEndDate As String, strMinPrice As String, _
strMaxPrice As String, strMinRating As String, strMaxRating As String, _
strCountry As String, strState As String, strRegion As String, strAppellation
As String) As Boolean

On Error GoTo Err_BuildSearchString

'Declarations
Dim frm As Form
Dim strFrom As String
Dim strWhere As String
Dim strBuildString As String
Dim strBuildCriteria As String
Dim strDelim As String
Dim strChk As String
Dim boofirstflag As Boolean
Dim intSelItem As Variant

'Start building search string
'Set the SELECT statement
Const strSelect = "SELECT tblWineNotes.BottleID "

'Set the FROM statement based on which listboxes are used
'Choosing Country, State, Region or Appellation creates a right join with
tblWineMap table
'Const strFrom = "FROM tblGames " (this is no longer being used)
With Forms("frmReportsMain")
'Check to see if any of the geographical listboxes are being used
If .lboCountry.ItemsSelected.Count _
Or .lboState.ItemsSelected.Count _
Or .lboRegion.ItemsSelected.Count _
Or .lboAppellation.ItemsSelected.Count Then
strFrom = "FROM tblWineMap RIGHT JOIN tblWineNotes ON tblWineMap.
RegionID=tblWineNotes.RegionID "
Else
strFrom = "FROM tblWineNotes "
End If
End With

'Set the ORDER BY statement
Const strOrderBy = "ORDER BY tblWineNotes.TastingDate DESC;"

'Set the strDelim string
strDelim = """"

'Building the string now that we have strSelect and strFrom
strFullString = strSelect & strFrom

boofirstflag = False ' this flag shows whether a WHERE has yet been
added

Set frm = Forms("frmReportsMain")

' Search by WineType
If frm.lboWineType.ItemsSelected.Count Then
boofirstflag = True
strWhere = "WHERE tblWineNotes.WineTypeID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboWineType.ItemsSelected
strBuildString = strBuildString & "," & frm.lboWineType.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboWineType.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strWineType = "Wine Type: " & strBuildCriteria
Else
strWineType = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Varietal
If frm.lboVarietal.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.PrimaryGrapeID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboVarietal.ItemsSelected
strBuildString = strBuildString & "," & frm.lboVarietal.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboVarietal.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strVarietal = "Primary Varietal: " & strBuildCriteria
Else
strVarietal = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by Vintage
If frm.lboVintage.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.VintageID In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboVintage.ItemsSelected
strBuildString = strBuildString & "," & frm.lboVintage.ItemData
(intSelItem)
strBuildCriteria = strBuildCriteria & ", " & frm.lboVintage.
Column(1, intSelItem)
Next intSelItem
If strBuildString <"" Then
strBuildString = Right(strBuildString, Len(strBuildString) - 1)
End If 'strips out superfluous leading comma
If strBuildCriteria <"" Then
strBuildCriteria = Right(strBuildCriteria, Len(strBuildCriteria) -
2)
strVintage = "Vintage: " & strBuildCriteria
Else
strVintage = ""
End If 'strips out superfluous leading comma and space
strWhere = strWhere & strBuildString & ") "
End If

' Search by WineStyle
If frm.lboWineStyle.ItemsSelected.Count Then
If boofirstflag = True Then
strWhere = strWhere & "AND "
Else
strWhere = "WHERE "
boofirstflag = True
End If
strWhere = strWhere & "tblWineNotes.WineStyle In ("
strBuildString = ""
strBuildCriteria = ""
For Each intSelItem In frm.lboWineStyle.ItemsSelected
strBuildString = strBuildString & "," & strDelim & frm.
lboWineStyle.ItemData(intSelItem) & strDelim
strBuildCriteria = strBuildCriteria & ", " &
...

read more

Apr 18 '07 #8

P: n/a
"H o o k e r D B A [MSFT]" <d b a h o o k e r@hotmail.comwrote:
>it's really really really simple

don't listen to these DAO dorks.
use ADO and your nightmare goes away
Text that A a r o n K e m p f wrote snipped.

Note that this person is really A a r o n K e m p f and that he is not an employee
of Microsoft.

Tony
--
Tony Toews, Microsoft Access MVP
Please respond only in the newsgroups so that others can
read the entire thread of messages.
Microsoft Access Links, Hints, Tips & Accounting Systems at
http://www.granite.ab.ca/accsmstr.htm
Apr 19 '07 #9

P: n/a
FINALLY found the problem!

The problem was within the code tied to my clear button which clears all of
the selections:

My code was looping through every row in each of the seven multi-select
listboxes (some of which have close to a hundred rows...), regardless of
whether the item was selected or not, and was tying up a lot of memory as a
result (after just a few searches) - I changed the code so it loops through
the itemsselected collections only - Access no longer hangs.

Thanks for all of your help on this.

Keith Wilby wrote:
>Command button - DoCmd.Quit on click event -

Clutching at straws here but it might be worth looking at putting the Quit
command in a hidden form's Close event and have your buttons close the
hidden form. Not ever having encountered your problem I don't know if it
will help but it might be worth trying.

Regards,
Keith.
--
Message posted via http://www.accessmonster.com

Apr 28 '07 #10

This discussion thread is closed

Replies have been disabled for this discussion.