The below code exports data from Access 97 to Excel 97. I'm writting data to two different tab in the Excel file. One the first tab everything works as it should, including the freezepane. When the code reaches the line in the code to freezepane on the second tab I get the error indicated in the subject line of this message "Select Method of Range Class Failed". Not really sure where I'm going wrong with it but if I comment out the problem line everything works fine for both tabs. Sorry about the length of the code but I figured you should see all of it. I've highlight the problem line. Any ideas? Thanks.
Code:
Sub ecDTR()
On Error GoTo ErrHandler
' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Dim highLight As Boolean
Dim sheetsPerBook As Integer
'CONSTANTS
Const aTab As Byte = 1
Const bTab As Byte = 2
Const aStartRow As Byte = 2
Const aStartColumn As Byte = 1
' set to break on all errors
Application.SetOption "Error Trapping", 0
' GENERATING OUTPUT FILE NAME
sOutput = "S:\HWYREPORTS\COL\Accounts\E\Emerson\TEST EmersonDTR_" & Format(Now(), "yyyymmdd") & ".xls"
If Dir(sOutput) <> "" Then Kill sOutput
' CREATING EXCEL AND DB OBJECTS
Set appExcel = New Excel.Application
sheetsPerBook = appExcel.SheetsInNewWorkbook
appExcel.SheetsInNewWorkbook = 2 ' SETTING NUMBER OF WORKSHEETS IN WORKBOOK
Set wbk = appExcel.Workbooks.Add
appExcel.SheetsInNewWorkbook = sheetsPerBook
Set wks = wbk.Worksheets(aTab)
Set dbs = CurrentDb
sSQL = "select * from DTRexportDIV"
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
' ADDING COLUMN HEADERS TO EXCEL FILE
With wks
iCol = aStartColumn
iRow = (aStartRow - 1)
If Not rst.BOF Then rst.MoveFirst
iFld = 0
lRecords = lRecords + 1
For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)
.Cells(iRow, iCol) = rst.Fields(iFld).Name
.Cells(iRow, iCol).Interior.ColorIndex = 36
.Cells(iRow, iCol).Font.ColorIndex = 1
.Cells(iRow, iCol).Font.Bold = True
iFld = iFld + 1
Next
iRow = iRow + 1
rst.MoveNext
End With
With wks
.Rows("2").Activate
appExcel.ActiveWindow.FreezePanes = True
End With
' ADDING DATA TO EXCEL FILE
iCol = aStartColumn
iRow = aStartRow
highLight = False
With wks
If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)
.Cells(iRow, iCol) = rst.Fields(iFld)
iFld = iFld + 1
Next
iRow = iRow + 1
rst.MoveNext
Loop
End With
'AUTOFITTING COLUMNS
With wks
.Columns("A:AJ").EntireColumn.AutoFit
End With
'FORMATTING COLUMNS
With wks
.Columns("J:J").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("K:K").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("L:L").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("N:N").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("O:O").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("V:V").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("W:W").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("X:X").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("Z:Z").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AA:AA").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AF:AF").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AG:AG").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AH:AH").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AI:AI").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AJ:AJ").EntireColumn.NumberFormat = "mm/dd/yy"
.Cells(aStartRow, aStartColumn).Select
End With
' NAMING TAB(S)
With wbk
wks.Select
wks.Name = "Div_DTR"
End With
Set rst = Nothing
Set wks = Nothing
'*****************ADDING INFO TO SECOND SHEET***************************
Set wks = appExcel.Worksheets(bTab)
sSQL = "select * from DTRexportPOSKU"
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
' ADDING COLUMN HEADERS TO EXCEL FILE
With wks
iCol = aStartColumn
iRow = (aStartRow - 1)
If Not rst.BOF Then rst.MoveFirst
iFld = 0
lRecords = lRecords + 1
For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)
.Cells(iRow, iCol) = rst.Fields(iFld).Name
.Cells(iRow, iCol).Interior.ColorIndex = 36
.Cells(iRow, iCol).Font.ColorIndex = 1
.Cells(iRow, iCol).Font.Bold = True
iFld = iFld + 1
Next
iRow = iRow + 1
rst.MoveNext
End With
With wks
[highlight].Rows("2").Select[/highlight]
appExcel.ActiveWindow.FreezePanes = True
End With
' ADDING DATA TO EXCEL FILE
iCol = aStartColumn
iRow = aStartRow
highLight = False
With wks
If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)
.Cells(iRow, iCol) = rst.Fields(iFld)
iFld = iFld + 1
Next
iRow = iRow + 1
rst.MoveNext
Loop
End With
'AUTOFITTING COLUMNS
With wks
.Columns("A:BC").EntireColumn.AutoFit
End With
'FORMATTING COLUMNS
With wks
.Columns("N:N").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("O:O").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("P:P").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("S:S").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("X:X").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("Y:Y").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("Z:Z").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AE:AE").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AF:AF").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AI:AI").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AJ:AJ").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AO:AO").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AP:AP").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AQ:AQ").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AR:AR").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AS:AS").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AX:AX").EntireColumn.NumberFormat = "mm/dd/yy"
.Columns("AY:AY").EntireColumn.NumberFormat = "mm/dd/yy"
End With
' NAMING TAB(S)
With wbk
wks.Select
wks.Name = "Div_BOL_PO_SKU_DTR"
End With
'CLOSING AND SAVING NEW FILES
Set wks = Nothing
wbk.SaveAs FileName:=sOutput, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
wbk.Close SaveChanges:=False
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set dbs = Nothing
Set rst = Nothing
ExitProcedure:
Exit Sub
ErrHandler:
Select Case Err.Number
Case Else
Call UnexpectedError(Err.Number, "ecSPNEM: " _
& Err.Description, Err.Source, _
Err.HelpFile, Err.HelpContext)
Resume ExitProcedure
Resume
End Select
End Sub
