Hubbsjp21
asked on
VBA code in Access 2010 used to work in 2003, but not now
I recently dug up a database that was created in Access 2003, and it had some code that would export data to Excel 2003, and then format the worksheet. Well since that time, my company is now using both Access 2010, and Excel 2010. When I try to run the code (in the click event of an Access button), I get the following error:
"Run-time error '1004'
Application-defined or object defined error"
When I go to debug, line 104 is highlighted. I have already worked through a few other bugs, but I can't figure this one out. I had to change the variable "wks" from being declared as a worksheet to being declared as an object. Not sure why. I coded around line 104 just to see if the rest of the code would run, and it did with the exception of line 133, which is the exact same code as line 104, and lines 159 and 166. I can ask new questions for those after I have resolved the issue of line 104.
Any and all help is much appreciated!
Thanks - Hubbs
"Run-time error '1004'
Application-defined or object defined error"
When I go to debug, line 104 is highlighted. I have already worked through a few other bugs, but I can't figure this one out. I had to change the variable "wks" from being declared as a worksheet to being declared as an object. Not sure why. I coded around line 104 just to see if the rest of the code would run, and it did with the exception of line 133, which is the exact same code as line 104, and lines 159 and 166. I can ask new questions for those after I have resolved the issue of line 104.
Any and all help is much appreciated!
Thanks - Hubbs
Private Sub cmdFundedRpt_Click()
'This is the Funded Report
Dim rsAct As DAO.Recordset
Dim rsCat As DAO.Recordset
Dim i As Integer, j As Integer, shtCnt As Integer
Dim colCnt, rowCnt, iCol, iRow
Dim xlObj As Object, nSheet As Object
Dim sqlCat As String
Dim sSql As String
Dim Catcnt As Integer
txtNameEnd = Format(Now(), "mmddyy_hh_nn_ss")
'add a new excel file
Set xlObj = CreateObject("excel.application")
xlObj.Workbooks.Add
sSql = "SELECT * FROM qryActivity ORDER BY SortOrder, VCC_LnNum"
Set rsAct = CurrentDb.OpenRecordset(sSql)
Set nSheet = xlObj.ActiveWorkbook.Sheets("sheet1")
sqlCat = "SELECT DISTINCT Category FROM qryActivity"
Set rsCat = CurrentDb.OpenRecordset(sqlCat)
If rsCat.EOF Then Exit Sub
rsCat.MoveLast
Catcnt = rsCat.RecordCount
'rename the sheet
nSheet.Name = ("SS_Activity")
'copy the headers
For iCol = 0 To rsAct.Fields.Count - 1
nSheet.Cells(1, iCol + 1).Value = rsAct.Fields(iCol).Name
Next
With nSheet
.Range("A2").CopyFromRecordset rsAct 'copy the data
'format the sheet
colCnt = .UsedRange.Columns.Count
rowCnt = .UsedRange.Rows.Count
.Range("A1:" & Chr(64 + colCnt) & 1).Interior.ColorIndex = 48
.Range("A1:" & Chr(64 + colCnt) & 1).Borders.LineStyle = xlContinuous
.Range("A1:" & Chr(64 + colCnt) & 1).Font.Bold = True
.Range("A1:" & Chr(64 + colCnt) & rowCnt).Columns.AutoFit
.Range("B:B").ColumnWidth = 16
.Range("C:C").ColumnWidth = 35
.Range("D:D").ColumnWidth = 18
'.Range("D:D").NumberFormat = "m/d/yyy"
'.Range("D:D").HorizontalAlignment = xlHAlignCenter
.Range("E:E").ColumnWidth = 16
.Range("E:E").NumberFormat = "[$$-409]#,##0.00"
.Range("F:F").ColumnWidth = 16
.Range("F:F").NumberFormat = "[$$-409]#,##0.00"
.Range("G:G").ColumnWidth = 12
.Range("G:G").NumberFormat = "m/d/yyy"
'.Range("G:G").HorizontalAlignment = xlHAlignCenter
.Range("H:H").ColumnWidth = 14
'.Range("H:H").NumberFormat = "m/d/yyy"
.Range("I:I").ColumnWidth = 12
.Range("I:I").NumberFormat = "m/d/yyy"
.Range("J:J").ColumnWidth = 18
'.Range("J:J").HorizontalAlignment = xlHAlignCenter
.Range("K:K").ColumnWidth = 5
'.Range("K:K").HorizontalAlignment = xlHAlignCenter
.Range("L:L").ColumnWidth = 12
.Range("L:L").NumberFormat = "m/d/yyy"
.Range("M:M").ColumnWidth = 12
End With
xlObj.ActiveWorkbook.SaveAs "P:\VCC Servicing\Servicing\SpecServActivity_" & Forms!frmRptGenerator.txtNameEnd & ".xlsx"
Set nSheet = Nothing
xlObj.Quit
'Set xlObj = Nothing
rsAct.Close
Set rsAct = Nothing
Dim lngRow As Long, lngRowCount As Long, lngStartRow As Long, lngEndRow As Long
Dim lngGroupCol As Long, lngCountCol As Long, lngSumCol As Long
Dim xpath As String
Dim wks As Object, wbk As Object
Dim strSubtotalHead As String, strGroupHead As String
xpath = "P:\VCC Servicing\Servicing\SpecServActivity_" & Forms!frmRptGenerator.txtNameEnd & ".xlsx"
xlObj.Workbooks.Open (xpath)
Set wbk = xlObj.ActiveWorkbook
'Set wbk = Workbooks.Open(xpath)
Set wks = wbk.Sheets("SS_Activity")
' This is the column number of MS_Current
lngGroupCol = 10
' Counting column - Loan_Num
lngCountCol = 1
' Sum column - Loan Amount
lngSumCol = 5
' Get last used row
lngRowCount = wks.Cells(wks.Rows.Count, lngGroupCol).End(xlUp).Row
'lngRowCount = 19
lngEndRow = lngRowCount + 1
With wks
For lngRow = lngRowCount To 2 Step -1
' check if Category is the same for both rows
If .Cells(lngRow - 1, lngGroupCol).Value <> .Cells(lngRow, lngGroupCol).Value Then
' If not, add a new row for totals
'.Rows(lngEndRow).Insert
.Range(lngEndRow & ":" & lngEndRow + 1).Insert
' Fill in count and sum formulas
.Cells(lngEndRow, "D").FormulaR1C1 = "=subtotal(3,R" & lngRow & "C:R[-1]C)"
.Cells(lngEndRow, lngSumCol).FormulaR1C1 = "=subtotal(9,R" & lngRow & "C:R[-1]C)"
.Cells(lngEndRow, "C").Value = .Cells(lngRow, lngGroupCol).Value & " Subtotals:"
' Apply formatting to first 9 cells in row - change formats as required
With .Cells(lngEndRow, 1).Resize(1, 13)
.Font.Bold = True
'.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 37
End With
lngEndRow = lngRow
End If
'MsgBox wks.Name
Next lngRow
' Add Grand totals
lngRowCount = wks.Cells(wks.Rows.Count, lngSumCol).End(xlUp).Row
'lngRowCount = 34
With .Cells(lngRowCount + 2, "A")
.Value = "Funded or Completed Totals:"
' add formatting out as far as Group column
With .Resize(1, 13)
.Interior.ColorIndex = 15
.Font.Bold = True
End With
End With
.Cells(lngRowCount + 2, "D").FormulaR1C1 = "=subtotal(3,R2C:R[-1]C)"
With .Cells(lngRowCount + 2, lngSumCol)
.FormulaR1C1 = "=SUBTOTAL(9,R2C:R[-2]C)"
'With .EntireRow
' .Interior.ColorIndex = 35
' .Font.Bold = True
'.Borders.LineStyle = xlContinuous
'.EntireColumn.NumberFormat = "[$$-409]#,##0.00"
'End With
End With
End With
wbk.Save
'wks.Activate
wks.Select
wks.Range("A1").Select
Selection.EntireRow.Insert shift:=xlShiftDown
Selection.EntireRow.Insert shift:=xlShiftDown
Selection.EntireRow.Insert shift:=xlShiftDown
wks.Columns("A:A").Hidden = True
wks.Range("B2").Value = "Activity Report: " & [Forms]![frmRptGenerator]![txtstartDate] & " To " & [Forms]![frmRptGenerator]![txtendDate]
wks.Range("B2").Font.Bold = True
wks.Range("B2").Font.Size = 14
' Save workbook
wbk.Application.Visible = True
wbk.Save
' Dim xltmp As New Excel.Application
' xltmp.Workbooks.Open ("P:\JPH_Data\Sales\Reports\Target_" & Forms!frmRptGenerator.txtNameEnd & ".xls")
' xltmp.Application.Visible = True
' xltmp.Parent.Windows(1).Visible = True
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
FWIW:
Dim colCnt, rowCnt, iCol, iRow
...Here these will all be Variants ...Is this what is really needed?
Dim colCnt, rowCnt, iCol, iRow
...Here these will all be Variants ...Is this what is really needed?
ASKER
Thanks!