VBA code in Access 2010 used to work in 2003, but not now

Posted on 2011-10-26
Last Modified: 2012-05-12
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
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")

    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
    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
    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
    'Set xlObj = Nothing
    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
            .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
   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

   ' 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

Open in new window

Question by:Hubbsjp21
    LVL 61

    Accepted Solution

    Make sure you have set the appropriate references.

    From the VBA Editor:

    Tools -> references

    Update any that are labeled as "MISSING"

    Author Comment

    Shame frickin' on me for not looking at that before I did anything else!

    LVL 74

    Expert Comment

    by:Jeffrey Coachman

    Dim colCnt, rowCnt, iCol, iRow
    ...Here these will all be Variants ...Is this what is really needed?


    Featured Post

    Why You Should Analyze Threat Actor TTPs

    After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

    Join & Write a Comment

    The first two articles in this short series — Using a Criteria Form to Filter Records ( and Building a Custom Filter ( — discuss in some detail how a form can be…
    How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
    The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
    This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

    755 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now