I stepped through the code and found that it fails on this line.
Expand|Select|Wrap|Line Numbers
- iRow = rst.RecordCount + 1
This is the full code for the Command Button.
Expand|Select|Wrap|Line Numbers
- Private Sub cmd_XprtXls_Click()
- On Error GoTo Err_cmd_XprtXls_Click
- Dim Conn As ADODB.Connection
- Dim stPath As String
- Dim rst As ADODB.Recordset
- Dim sSQL As String
- Dim stErrMsg As String
- Dim sSelect As String
- Dim sFrom As String
- Dim sGroupBy As String
- Dim sHaving As String
- Dim sOrder As String
- Dim DblYr As Double
- Dim DblMn As Double
- Dim sPM As String
- Dim sROGT As String
- Dim stPrjt As String
- Dim sSbprjtGrp As String
- Dim stSbprjt As String
- Dim stOrg As String
- Dim stAct As String
- Dim xlApp As Object
- Dim xlWb As Object
- Dim xlWs As Object
- Dim acRng As Variant
- Dim iRow As Integer
- DoCmd.Hourglass True
- ' Debug.Print Me.Name & " Start Export: " & Now()
- stErrMsg = ""
- If IsNull(Me.cmb_ExpYr.Value) Then
- stErrMsg = stErrMsg & vbCrLf & "Year"
- End If
- If IsNull(Me.cmb_ExpMnth.Value) Then
- stErrMsg = stErrMsg & vbCrLf & "Month"
- End If
- '12/15/14 Requirements Changed per PMaC development group
- If Not IsNull(Me.cmb_PM) And IsNull(Me.cmbRptOwnerGrpTitle) Then
- strErrMsg = strErrMsg & vbCrLf & "Favorites is required when PM/Report Owner is selected"
- End If
- If IsNull(Me.cmb_ProjectID.Value) Then
- stErrMsg = stErrMsg & vbCrLf & "Project"
- End If
- If stErrMsg <> "" Then
- MsgBox "Please select the required information." & vbCrLf & stErrMsg, vbExclamation + vbOKOnly, "Missing Information"
- DoCmd.Hourglass False
- Exit Sub
- End If
- 'Set the query parameter values
- DblYr = Me.cmb_ExpYr.Value
- DblMn = Me.cmb_ExpMnth.Value
- stPrjt = Me.cmb_ProjectID
- ' 12/15/14
- If IsNull(Me.cmb_PM) Then
- sPM = "'%'"
- sROGT = "%"
- Else
- sPM = Me.cmb_PM
- sROGT = Me.cmbRptOwnerGrpTitle
- End If
- If IsNull(Me.cmbSbprjtGrp.Value) Then
- sSbprjtGrp = "%"
- Else
- sSbprjtGrp = Me.cmbSbprjtGrp.Value
- End If
- If IsNull(Me.cmb_SubprojectID) Then
- stSbprjt = "%"
- Else
- stSbprjt = Me.cmb_SubprojectID
- End If
- If IsNull(Me.cmb_ActivityID) Then
- stAct = "%"
- Else
- stAct = Me.cmb_ActivityID
- End If
- If IsNull(Me.cmb_OrgGrp) Then
- stOrg = "%"
- Else
- stOrg = Me.cmb_OrgGrp
- End If
- sSelect = "SELECT [LTD]![ProjectDescription] AS [Project ID - Description]" _
- & ", [LTD]![SUBPROJECTDESCRIPTION] AS [Subproject ID - Description]" _
- & ", [LTD]![ActivityDESCR] AS [Activity ID - Description]" _
- & ", [LTD]![PROJECT_TO] AS [Funding Project ID - Description]" _
- & ", [LTD]![SUBPROJECT_TO] AS [Funding Subproject ID - Description]" _
- & ", [LTD]![Activity_To] AS [Funding Activity ID - Description]" _
- & ", LTD.VndrEmpName AS Name, [LTD]![Phase] & ' - ' & [tblPhaseDescr]![Description] AS Phase" _
- & ", LTD.Organization AS [Org - Description]" _
- & ", LTD.OrgGrp AS [Org Group]" _
- & ", LTD.Labor AS [Account Group]" _
- & ", LTD.FiscalYear AS [Year]" _
- & ", LTD.AccountingPeriod AS [Month]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]= " & DblMn & ",[LTD]![EXPENDITURES],0)) AS [Current Month Amt]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]<= " & DblMn & ",[LTD]![EXPENDITURES],0)) AS [Year to Date Amt]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]<= " & DblMn & ",[LTD]![EXPENDITURES],IIf([LTD]![FiscalYear]<= " & DblYr & ",[LTD]![EXPENDITURES],0))) AS [Life To Date Amt]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]= " & DblMn & ",[LTD]![Hours],0)) AS [Current Month Hrs]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]<= " & DblMn & ",[LTD]![Hours],0)) AS [Year to Date Hrs]" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]<= " & DblMn & ",[LTD]![Hours],IIf([LTD]![FiscalYear]<" & DblYr & ",[LTD]![Hours],0))) AS [Life To Date Hrs]"
- sFrom = "FROM (SELECT Trim([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![SubprojectID]) AS SubprojectID" _
- & " FROM zqselMngrSbprjtRptGrpSbprjtFltr_Exp" _
- & " WHERE (((IIf([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![GROUPINGCODE] Is Null,'ZZZ',[zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![GROUPINGCODE]) ALike '" & sSbprjtGrp & "'))" _
- & " AND ((IIf([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![RPTGRPTITLE] Is Null,'ZZZ',[zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![RPTGRPTITLE]) ALike '" & sROGT & "'))" _
- & " AND ((IIf([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![RptOwnerID] Is Null,0,[zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![RptOwnerID])) ALike " & sPM & ")" _
- & " AND ((zqselMngrSbprjtRptGrpSbprjtFltr_Exp.PROJECTID ALike '" & stPrjt & "')))" _
- & " GROUP BY Trim([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![SubprojectID])" _
- & " HAVING (((Trim([zqselMngrSbprjtRptGrpSbprjtFltr_Exp]![SubprojectID])) ALike '" & stSbprjt & "'))) AS qrptSbPrjtLTDPrgmCMYTDLTDSbprjtFltrd" _
- & " LEFT JOIN (tblPrjtLTDExpndRptBase AS LTD " _
- & " LEFT JOIN tblPhaseDescr ON LTD.Phase = tblPhaseDescr.PHASE)" _
- & " ON qrptSbPrjtLTDPrgmCMYTDLTDSbprjtFltrd.SubprojectID = LTD.SUBPROJECTID"
- sGroupBy = " GROUP BY [LTD]![ProjectDescription]" _
- & ", [LTD]![SUBPROJECTDESCRIPTION]" _
- & ", [LTD]![ActivityDESCR]" _
- & ", [LTD]![PROJECT_TO]" _
- & ", [LTD]![SUBPROJECT_TO]" _
- & ", [LTD]![Activity_To]" _
- & ", LTD.VndrEmpName" _
- & ", [LTD]![Phase] & ' - ' & [tblPhaseDescr]![Description]" _
- & ", LTD.Organization" _
- & ", LTD.OrgGrp" _
- & ", LTD.Labor" _
- & ", LTD.FiscalYear" _
- & ", LTD.AccountingPeriod" _
- & ", LTD.ACTIVITYID"
- sHaving = " HAVING (((LTD.OrgGrp) ALike """ & stOrg & """) AND ((LTD.FiscalYear)=" & DblYr & ") AND ((LTD.AccountingPeriod)<=" & DblMn & ")" _
- & " AND ((LTD.ACTIVITYID) ALike '" & stAct & "') AND ((Sum(LTD.Expenditures))<>0)) " _
- & " OR (((LTD.OrgGrp) ALike """ & stOrg & """) AND ((LTD.FiscalYear)<" & DblYr & ") AND ((LTD.ACTIVITYID) ALike '" & stAct & "') AND ((Sum(LTD.Expenditures))<>0))"
- sOrder = " ORDER BY Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]= " & DblMn & ",[LTD]![EXPENDITURES],0))" _
- & ", Sum(IIf([LTD]![FiscalYear]= " & DblYr & " And [LTD]![AccountingPeriod]<= " & DblMn & ",[LTD]![EXPENDITURES],0))"
- ' Open recordset
- Set rst = New ADODB.Recordset
- sSQL = sSelect & vbCrLf & sFrom & vbCrLf & sGroupBy & vbCrLf & sHaving & ";"
- ' Debug.Print sSQL
- rst.Open sSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
- If rst.BOF And rst.EOF Then
- MsgBox "No Data Available to Export", vbOKOnly, "No Data"
- DoCmd.Hourglass False
- Exit Sub
- End If
- rst.MoveLast
- ' Debug.Print rst.RecordCount
- iRow = rst.RecordCount + 1
- ' Create an instance of Excel and add a workbook
- Set xlApp = New Excel.Application
- Set xlWb = xlApp.Workbooks.Add
- Set xlWs = xlWb.Worksheets("Sheet1")
- ' Display Excel and give user control of Excel's lifetime
- xlApp.Visible = True
- xlApp.UserControl = True
- ' Copy field names to the first row of the worksheet
- fldCount = rst.Fields.Count
- For iCol = 1 To fldCount
- xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
- Next
- rst.MoveFirst
- ' Copy the recordset to the worksheet, starting in cell A2
- xlWs.Range("A2", "XFD" & iRow).CopyFromRecordset rst
- ' Auto-fit the column widths and row heights
- xlApp.Selection.CurrentRegion.Columns.AutoFit
- xlApp.Selection.CurrentRegion.Rows.AutoFit
- xlWs.Range("N2", "P" & iRow).NumberFormat = "$#,###;($#,###)[Red];-;-" 'Format the Amounts
- xlWs.Range("Q2", "S" & iRow).NumberFormat = "#,###;(#,###)[Red];-;-" 'Format the Hours
- ' Close ADO objects
- rst.Close
- ' conn.Close
- Set rst = Nothing
- ' Set conn = Nothing
- ' Release Excel references
- Set xlWs = Nothing
- Set xlWb = Nothing
- Set xlApp = Nothing
- DoCmd.Hourglass False
- Exit_cmd_XprtXls_Click:
- Exit Sub
- Err_cmd_XprtXls_Click:
- DoCmd.Hourglass False
- If Err.Number = 6 Then
- MsgBox "The dataset you have choosen to export is too large. Use additional filters to limit the dataset. "
- Else
- MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
- DoCmd.SetWarnings True
- DoCmd.Hourglass False
- End If
- Resume Exit_cmd_XprtXls_Click
- End Sub