1004 Error after export to Excel

[dmkennard2]

Hi,
I can run the code below once in the database, but when i try to run it again i get an error:

1004 - Method 'Cells' of object'_Global' Failed
Error occured during FormatExcelBasic function.

If i shutdown the database and restart the code works again.

Any help would be much appreciated.

Dazz
---------------

Sub Operating_Lease()

Dim MyDate, MyStr
Dim strPath As String
MyDate = Date
MyStr = Format(MyDate, "dd-mmm-yyyy")

' Delete Current File
delwkbk = MsgBox("This action will overwrite any file created today!" & Chr$(13) & "Do you want to continue?", vbYesNo, "File Deleting Warning")
If delwkbk = vbNo Then Exit Sub
strPath = "\\Test\Testdatabase\test " & MyStr & ".xls"
If Dir(strPath) <> "" Then Kill strPath

' Create new workbook
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryOperating_Lease_Request", "\\Test\Testdatabase\test " & MyStr & ".xls", True
' Open the new workbook
OWkbk = MsgBox("Export Sucessful!" & Chr$(13) & "Click OK to open the workbook and automatically format!", vbOKOnly, "Export Success")

'Open Workbook and format it

On Error GoTo errHandling
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range
Dim lngLastRow As Long
Dim lngLastColumn As Long
Dim strCell As String

filein = ("\\Test\Testdatabase\test " & MyStr & ".xls")
sheetin = ("qryOperating_Lease_Request")

Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(filein)
xlApp.StatusBar = "Sheet Fomatting, please wait....."
' Autofit Columns
Set xlSheet = xlBook.Sheets(sheetin)
xlSheet.Cells.EntireColumn.AutoFit
' Set Font Formatting
Set xlRange = xlSheet.Rows(1)
xlRange.Font.Bold = True
xlRange.Font.Size = 10
xlRange.HorizontalAlignment = xlCenter
xlRange.Interior.ColorIndex = 15
xlRange.Interior.Pattern = xlSolid
Set xlRange = xlSheet.Cells.EntireRow
xlRange.Font.Size = 8
xlSheet.Cells.EntireColumn.AutoFit
Set xlRange = xlSheet.Columns("E:F")
xlRange.HorizontalAlignment = xlCenter
Set xlRange = xlSheet.Columns("H:J")
xlRange.HorizontalAlignment = xlRight
Set xlRange = xlSheet.Columns("L:M")
xlRange.HorizontalAlignment = xlCenter
Set xlRange = xlSheet.Columns("N:N")
xlRange.Delete Shift:=xlToLeft

' Enter New Headings
xlSheet.Cells(1, 1).Value = "Region"
xlSheet.Cells(1, 2).Value = "Type"
xlSheet.Cells(1, 3).Value = "Service"
xlSheet.Cells(1, 4).Value = "Description"
xlSheet.Cells(1, 5).Value = "Start Date"
xlSheet.Cells(1, 6).Value = "Expiry Date"
xlSheet.Cells(1, 7).Value = "Currency"
xlSheet.Cells(1, 8).Value = "Storage"
xlSheet.Cells(1, 9).Value = "Handling"
xlSheet.Cells(1, 10).Value = "Transport"
xlSheet.Cells(1, 11).Value = "Variable/Fixed"
xlSheet.Cells(1, 12).Value = "Posted to"
xlSheet.Cells(1, 13).Value = "Cost"
xlSheet.Cells(1, 14).Value = "Break Clause"
xlSheet.Cells(1, 15).Value = "Value of Break Clause"
xlSheet.Cells(1, 16).Value = "Notes"

Set xlSheet = xlBook.Sheets(sheetin)
xlSheet.Cells.EntireColumn.AutoFit
' Open up Notes column
Set xlRange = xlSheet.Columns("P")
xlRange.Cells.EntireColumn.ColumnWidth = 30


' Make table the selectable range
xlSheet.Range("A1").Select
lngLastRow = xlSheet.Range("A65536").End(xlUp).Row
lngLastColumn = xlSheet.Range("AA1").End(xlToLeft).Column
Set xlRange = xlSheet.Range(Cells(1, 1), Cells(lngLastRow, lngLastColumn))

' Sort data by Region
With xlRange
.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With

' Put boarders round everything
Range("A1").Select
With xlRange.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'Change Currency format to Number
Set xlRange = xlSheet.Columns("H:J")
xlRange.NumberFormat = "#,##0"
Range("A1").Select

' Set the page orientation
With xlSheet.PageSetup
.CenterFooter = "Page &P" 'print the page number bottom center
.LeftMargin = xlApp.InchesToPoints(0.25)
.RightMargin = xlApp.InchesToPoints(0.25)
.TopMargin = xlApp.InchesToPoints(0.5)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
.PrintQuality = 600
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.Zoom = 100
.FitToPagesTall = 1
.FitToPagesWide = 1
.PrintErrors = xlPrintErrorsDisplayed
.PrintGridlines = True
End With
xlApp.StatusBar = ""
xlBook.Save
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

Exit Sub

errHandling:
MsgBox Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & _
"Error occurred during FormatExcelBasic function.", vbCritical, "Error!"

On Error Resume Next
xlBook.Save
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub

Resume

End Sub

 

[PHV]

You have to fully qualify ALL referenes to Excel objects, eg:
.Sort Key1:=[highlight].[/highlight]Range("A2"),

[highlight]xlSheet.[/highlight]Range("A1").Select 'WHY selecting ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[dmkennard2]

PHV to the rescue again.
Easy one first.
Not sure why i was selecting, i have taken this out.

I have changed the line as you describe, but still get the same message. Is it the whole sorting part that is wrong?

Dazz

 

[PHV]

You had TWO occurrences of Range("A1").Select ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[dmkennard2]

Thanks PHV, Still getting the error when i try and run the code twice, but we can live with it for now.

I have another question on the export.
Can i apply conditional formatting to rows based on a cell in that row using this code, My brain cant seem to work it out!!

Thanks again

Dazz

 

[PHV]

You missed xlApp.Quit before Set xlApp = Nothing

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886