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
