Link to home
Start Free TrialLog in
Avatar of Hubbsjp21
Hubbsjp21Flag for United States of America

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
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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of mbizup
mbizup
Flag of Kazakhstan image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Hubbsjp21

ASKER

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

Thanks!
FWIW:

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