[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 811
  • Last Modified:

Getting Error - Object Variable or With Block Variable Not Set . . .

I have the following code that displays a message box if there are no records in the "tblErrorDetails (for Report)" table.  After it displays the message box, and the OK button is clicked, the following error message appears:

      Object Variable pr With Block Variable Not Set

What am I doing wrong, is the Message Box in the correct location in the code?

Thanks,
gdunn59
 



Private Sub cmdDetErrRpt_Click()
On Error GoTo Err_cmdDetErrRpt_Click
Dim stDocNameMgr As String
Dim stDocNameEmp As String
Dim stDocNameDept As String
Dim stDocNameAuditor As String
Dim strOutputToPath As String
Dim rtn As String
Dim xlObj As Object
Dim xlWb As Object
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qdf As QueryDef
Dim qdf2 As QueryDef
Dim BegDate As String
Dim EndDate As String
Dim Template As String
Dim Hrs As String
Dim sMinDte As Variant
Dim sMaxDte As Variant
Dim stDocName As String
Dim stDocName2 As String
Dim stDocNameErrorDetailsALL As String
Dim stDocNameErrors As String

DoCmd.Echo False
DoCmd.SetWarnings False

DoCmd.Hourglass True

strOutputToPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\ErrorDetailReport_By" & "" & Me!cboReportCateg & "_" & Me!cboCategSelect & "_" & Format(Now(), "mm-dd-yyyy") & ".xlsx"

'Remove Report if process is run more than once daily
If Dir(strOutputToPath) <> "" Then Kill strOutputToPath

'Template on Network
Templatefile = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\TEMPLATE\Audit_DB_ErrorDetail_TEMPLATE.xltx"

stDocNameMgr = "qryErrorDetailByMgr (for Report)"
stDocNameEmp = "qryErrorDetailByEmp (for Report)"
stDocNameDept = "qryErrorDetailByDept (for Report)"
stDocNameAuditor = "qryErrorDetailByAuditor (for Report)"
stDocNameErrorDetailsALL = "qryErrorDetailAssocReport"
stDocNameErrors = "qryErrorScores"

DoCmd.OpenQuery stDocNameErrorDetailsALL
DoCmd.OpenQuery stDocNameErrors

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
ElseIf (Me.cboReportCateg) = "Manager" Then
    DoCmd.OpenQuery stDocNameMgr
ElseIf (Me.cboReportCateg) = "Employee" Then
    DoCmd.OpenQuery stDocNameEmp
ElseIf (Me.cboReportCateg) = "Department" Then
    DoCmd.OpenQuery stDocNameDept
ElseIf (Me.cboReportCateg) = "Auditor" Then
    DoCmd.OpenQuery stDocNameAuditor
End If

Set xlObj = CreateObject("excel.application")

xlObj.Workbooks.Add Templatefile

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
End If

If DCount("*", "tblErrorDetails (for Report)") > 0 Then
    With xlObj
    .Worksheets(1).Select
    .Range("A5").Select
    Set qdf = CurrentDb.QueryDefs("qryErrorDetails")
    qdf.Parameters("[Forms]![frmReports]![txtBeginDT]") = [Forms]![frmReports]![txtBeginDT]
    qdf.Parameters("[Forms]![frmReports]![txtEndDT]") = [Forms]![frmReports]![txtEndDT]
    
    Set rs = qdf.OpenRecordset
    .Selection.CopyFromRecordset rs

If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
'Go back to top of Spreadsheet and Save to Report Name
    .Worksheets(1).Select
    .Range("A1").Select
    .Range("A1") = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
    .Range("A2") = "Filtered By:" & " " & cboReportCateg
    .Range("A2").Font.Bold = True
    .Range("A5").Select
'    .ActiveWorkbook.SaveAs strOutputToPath
    .ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
Else
    .Worksheets(1).Select
    .Range("A1").Select
    .Range("A1") = "For Dates:  " & DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
    .Range("A2") = "Filtered By:" & " " & cboReportCateg
    .Range("A2").Font.Bold = True
    .Range("A5").Select
'    .ActiveWorkbook.SaveAs strOutputToPath
    .ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
End If

End With

Else
    MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
End If

rs.Close

DoCmd.Hourglass False

DoCmd.Echo False
xlObj.Visible = True
DoCmd.Echo True

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

'xlObj.Quit

Exit_Err_cmdDetErrRpt_Click:
    Exit Sub

Err_cmdDetErrRpt_Click:
If Err.Number = 2501 Then
    'no action required - ignore the error - because opening of report was cancelled
Else
    MsgBox Err.Description
End If

GoTo Exit_Err_cmdDetErrRpt_Click

Me.cboCategSelect = Null
Me.cboReportCateg = Null
Me.txtBeginDT = Null
Me.txtEndDT = Null
Me.cboDept = Null
rs.Close

DoCmd.SetWarnings True

End Sub

Open in new window

0
gdunn59
Asked:
gdunn59
1 Solution
 
peter57rCommented:
Care to give us a clue by indicating which line the error occurs on?
0
 
gdunn59Author Commented:
I mentioned in my post that it was after the MsgBox and the OK button is clicked:

Else
    MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
End If

Thanks,
gdunn59
0
 
IrogSintaCommented:
Move rs.close from line 111 to line 83.  Get rid of line 146.
0
 
aikimarkCommented:
Unless your major If statement condition is true:
If DCount("*", "tblErrorDetails (for Report)") > 0 Then


Then you will not have initialized your recordset variable (rs).  You need to check for that condition before trying to close the recordset.
Example:
If rs Is Nothing Then
Else
   rs.Close
End If

Open in new window

0
 
gdunn59Author Commented:
That worked.  I also moved the template line of code because if there weren't any records, it was still opening the template and keeping it opened.

Here is the final code:

Private Sub cmdDetErrRpt_Click()
On Error GoTo Err_cmdDetErrRpt_Click
Dim stDocNameMgr As String
Dim stDocNameEmp As String
Dim stDocNameDept As String
Dim stDocNameAuditor As String
Dim strOutputToPath As String
Dim rtn As String
Dim xlObj As Object
Dim xlWb As Object
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qdf As QueryDef
Dim qdf2 As QueryDef
Dim BegDate As String
Dim EndDate As String
Dim Template As String
Dim Hrs As String
Dim sMinDte As Variant
Dim sMaxDte As Variant
Dim stDocName As String
Dim stDocName2 As String
Dim stDocNameErrorDetailsALL As String
Dim stDocNameErrors As String

DoCmd.Echo False
DoCmd.SetWarnings False

DoCmd.Hourglass True

strOutputToPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\ErrorDetailReport_By" & "" & Me!cboReportCateg & "_" & Me!cboCategSelect & "_" & Format(Now(), "mm-dd-yyyy") & ".xlsx"

'Remove Report if process is run more than once daily
If Dir(strOutputToPath) <> "" Then Kill strOutputToPath

'Template on Network
Templatefile = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\TEMPLATE\Audit_DB_ErrorDetail_TEMPLATE.xltx"

stDocNameMgr = "qryErrorDetailByMgr (for Report)"
stDocNameEmp = "qryErrorDetailByEmp (for Report)"
stDocNameDept = "qryErrorDetailByDept (for Report)"
stDocNameAuditor = "qryErrorDetailByAuditor (for Report)"
stDocNameErrorDetailsALL = "qryErrorDetailAssocReport"
stDocNameErrors = "qryErrorScores"

DoCmd.OpenQuery stDocNameErrorDetailsALL
DoCmd.OpenQuery stDocNameErrors

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
ElseIf (Me.cboReportCateg) = "Manager" Then
    DoCmd.OpenQuery stDocNameMgr
ElseIf (Me.cboReportCateg) = "Employee" Then
    DoCmd.OpenQuery stDocNameEmp
ElseIf (Me.cboReportCateg) = "Department" Then
    DoCmd.OpenQuery stDocNameDept
ElseIf (Me.cboReportCateg) = "Auditor" Then
    DoCmd.OpenQuery stDocNameAuditor
End If

Set xlObj = CreateObject("excel.application")

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
End If

If DCount("*", "tblErrorDetails (for Report)") > 0 Then
xlObj.Workbooks.Add Templatefile
    With xlObj
    .Worksheets(1).Select
    .Range("A5").Select
    Set qdf = CurrentDb.QueryDefs("qryErrorDetails")
    qdf.Parameters("[Forms]![frmReports]![txtBeginDT]") = [Forms]![frmReports]![txtBeginDT]
    qdf.Parameters("[Forms]![frmReports]![txtEndDT]") = [Forms]![frmReports]![txtEndDT]
   
    Set rs = qdf.OpenRecordset
    .Selection.CopyFromRecordset rs
   
rs.Close

If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
'Go back to top of Spreadsheet and Save to Report Name
    .Worksheets(1).Select
    .Range("A1").Select
    .Range("A1") = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
    .Range("A2") = "Filtered By:" & " " & cboReportCateg
    .Range("A2").Font.Bold = True
    .Range("A5").Select
    .ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
Else
    .Worksheets(1).Select
    .Range("A1").Select
    .Range("A1") = "For Dates:  " & DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
    .Range("A2") = "Filtered By:" & " " & cboReportCateg
    .Range("A2").Font.Bold = True
    .Range("A5").Select
    .ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
End If

End With

Else
    MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
End If

DoCmd.Hourglass False

DoCmd.Echo False
xlObj.Visible = True
DoCmd.Echo True

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

Exit_Err_cmdDetErrRpt_Click:
    Exit Sub

Err_cmdDetErrRpt_Click:
If Err.Number = 2501 Then
    'no action required - ignore the error - because opening of report was cancelled
Else
    MsgBox Err.Description
End If

GoTo Exit_Err_cmdDetErrRpt_Click

Me.cboCategSelect = Null
Me.cboReportCateg = Null
Me.txtBeginDT = Null
Me.txtEndDT = Null
Me.cboDept = Null

DoCmd.SetWarnings True

End Sub
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now