austenr
11-15-2006, 12:27 PM
Can anyone tell me why this suddenly stopped working? The error is on the line "Dim objXL As Excel.Application".
Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 5000
Const conSHT_NAME = "ICM Detail Records No Sub Totals"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\ICM Reporting Test Excel.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("add svc type description", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Stmt Date", "Bank", "Acct #", "Grp Bank", "Grp Acct", "Acct Name", "Branch", "Prim Officer", "Unit Charge", "Nbr Items", "Total Chg", "Sv Type", "Sv Type Desc", "SVC Code", "SVC Code Desc")
Range("A1:M1").Value = myarray
Range("A1:O3000").Columns.AutoFit
'Columns("L:M").Select
'Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 5000
Const conSHT_NAME = "ICM Detail Records No Sub Totals"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\ICM Reporting Test Excel.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("add svc type description", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Stmt Date", "Bank", "Acct #", "Grp Bank", "Grp Acct", "Acct Name", "Branch", "Prim Officer", "Unit Charge", "Nbr Items", "Total Chg", "Sv Type", "Sv Type Desc", "SVC Code", "SVC Code Desc")
Range("A1:M1").Value = myarray
Range("A1:O3000").Columns.AutoFit
'Columns("L:M").Select
'Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub