Excel remaining open after many varying attempts to write quit via Access VBA

[ham355]

Hi all, I am running the code below, which outputs a couple of reports, then opens one back up to re-format in excel and save/close. It all looks great, but two things happen...

The first is that after running successfully the first time, when trying to run again it falls over and gives me the 'run time error 91 object variable or With block variable not set'

I then debug and it takes me to the line I have shown in red.

I then close the excel sheet which has opened, manually, and close the debugger, and run the report, which then works. (however, I can see from task manager that excel is remaining in RAM, hence if I try the access VBA again it falls over)



Whats missing from my code to get Excel to close properly each and every time the VBA executes!?

Thanks!

Private Sub Command7_Click()
Dim strWhere As String
strWhere = "[LEVELCODE1]=" & Chr(34) & Me.Combo0 & Chr(34)

DoCmd.OpenReport ReportName:="HOSURaw Query 2", _
View:=acViewPreview, WhereCondition:=strWhere
DoCmd.OpenReport ReportName:="HOSURaw Query 2 Excel", _
View:=acViewPreview, WhereCondition:=strWhere
Dim strpath As String
Dim strfilename As String
Dim queryname As String
Dim fieldname As String
Set db = CurrentDb()
fieldname = Me.Combo0
strpath = "C:\My Documents\Forecasting\HOSU Reporting\"
strfilename = "HOSU" & "_" & Format(Date, "ddmmyyyy") & "_" & fieldname & ".pdf"
strfilename2 = "HOSU" & "_" & Format(Date, "ddmmyyyy") & "_" & fieldname & ".xls"
DoCmd.OutputTo acOutputReport, "HOSURaw Query 2", ".pdf", strpath & strfilename, False
DoCmd.OutputTo acOutputReport, "HOSURaw Query 2 Excel", ".xls", strpath & strfilename2, False
DoCmd.Close acReport, "HOSURaw Query 2"
DoCmd.Close acReport, "HOSURaw Query 2 Excel"
MsgBox "Reports Created and Saved - Excel will now re-format the .xls output"
Dim objXL As Object
Dim strXls As String

strXls = strpath & strfilename2
Set objXL = CreateObject("Excel.Application")
With objXL
        .DisplayAlerts = False
        .Visible = True
        .Workbooks.Open (strXls)
    .Cells.Select
    .Selection.RowHeight = 13.5
    .Range("A1").Select
    .Selection.Cut
    .Range("P2").Select
    .ActiveSheet.Paste
    .Rows("1:1").Select
    .Selection.Delete Shift:=xlUp
        
        
        .Columns("I:O").Select
        .Selection.NumberFormat = "$#,##0_);[Red]($#,##0)"
        .Columns("A:A").Select
        .Application.CutCopyMode = False
        .Selection.Delete Shift:=xlToLeft
    .Range("A1").Select
    .ActiveCell.FormulaR1C1 = "'Sub-Unit"
    .Range("E1").Select
    .ActiveCell.FormulaR1C1 = "'Level 5"
    .Range("D1").Select
    .ActiveCell.FormulaR1C1 = "'Level 4"
    .Range("C1").Select
    .ActiveCell.FormulaR1C1 = "'Level 3"
    .Range("B1").Select
    .ActiveCell.FormulaR1C1 = "'Level 2"
    .Range("F1").Select
    .ActiveCell.FormulaR1C1 = "'Level 4 Description"
    .Range("G1").Select
    .ActiveCell.FormulaR1C1 = "'Level 5 Description"
    .Range("H1").Select
    .ActiveCell.FormulaR1C1 = "'Original Budget"
    .Range("I1").Select
    .ActiveCell.FormulaR1C1 = "'Full Year Current Forecast"
    .Range("J1").Select
    .ActiveCell.FormulaR1C1 = "'Current Forecast to Date"
    .Range("K1").Select
    .ActiveCell.FormulaR1C1 = "'Actual to Date"
    .Range("L1").Select
    .ActiveCell.FormulaR1C1 = "'Commitment"
    .Range("M1").Select
    .ActiveCell.FormulaR1C1 = "'Under / (Over) Spend to Date"
    .Range("N1").Select
    .ActiveCell.FormulaR1C1 = "'Balance available (Full Year Current Forecast - Actual to Date)"
    .Rows("1:1").Select
    .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    .Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    .Rows("4:4").Select
        .Selection.RowHeight = 56.25
        .Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A4:N4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .Selection.Borders(xlInsideVertical).LineStyle = xlNone
    .Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    .Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    .Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        Rows("4:4").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
        End With
    .Columns("A:A").Select
    .Selection.ColumnWidth = 7
        .Columns("B:B").Select
    .Selection.ColumnWidth = 7
        .Columns("C:C").Select
    .Selection.ColumnWidth = 7
        .Columns("D:D").Select
    .Selection.ColumnWidth = 7
        .Columns("E:E").Select
    .Selection.ColumnWidth = 7
    .Columns("F:F").Select
    .Selection.ColumnWidth = 37.14
        .Columns("G:G").Select
    .Selection.ColumnWidth = 24.43
        .Columns("H:H").Select
    .Selection.ColumnWidth = 8
        .Columns("I:I").Select
    .Selection.ColumnWidth = 8
        .Columns("J:J").Select
    .Selection.ColumnWidth = 8
        .Columns("K:K").Select
    .Selection.ColumnWidth = 8
        .Columns("L:L").Select
    .Selection.ColumnWidth = 12
        .Columns("M:M").Select
    .Selection.ColumnWidth = 8
        .Columns("N:N").Select
    .Selection.ColumnWidth = 14.14
  End With
  With objXL
    .Rows("4:4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        .Range("A1").Select
    .ActiveCell.FormulaR1C1 = "'Head of Spending Unit Report"
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    .Range("F2").Select
    .ActiveCell.FormulaR1C1 = "=TODAY()"
    .Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
    .Range("O4").Select
    .Selection.Cut
    .Range("L1").Select
    .ActiveSheet.Paste
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 15
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
      .Columns("H:N").Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=IF(AND($H5<>0),$A5="""")"
    .Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .Selection.FormatConditions(1).StopIfTrue = True
    .Range("A1").Select
    .ActiveWorkbook.Save
    End With
With objXL

objXL.Workbooks.Close
objXL.Application.Quit
Set objXL = Nothing
Set objActiveWkb = Nothing

End With
DoCmd.OpenReport ReportName:="HOSURaw Query 2", _
View:=acViewPreview, WhereCondition:=strWhere
EmailYesNo = MsgBox("Would you like to email the report in PDF?", vbYesNo, "Email?")
     
If EmailYesNo = vbYes Then
Dim email As String
email = email
DoCmd.SendObject _
    acSendReport, _
    "HOSURaw Query 2", _
    acFormatPDF, _
    email, _
    , _
    , _
    "HOSU" & "_" & Format(Date, "ddmmyyyy") & "_" & fieldname, _
    "Please find attached your latest HOSU Report, Thanks, Ian", _
    False
Else
GoTo B
End If
B:
DoCmd.Close acReport, "HOSURaw Query 2"
End Sub

[pbaldy]

The most common reason I've seen for Excel to remain running is when you fail to use your objXL variable. If you do, it creates a new instance of it, which obviously never gets closed/quit. You may poke around for those, but your highlighted line and others like it may be the culprit for both problems. In the same way you included a period before "Selection" here:


.Cells.Select
.Selection.RowHeight = 13.5

You probably need one here:

With .Selection

[John_G]

Hi -

pbaldy is right - you are missing a period before Selection. What happens is that an untrapped error is generated, which you don't see, or you see something else. Then because your procedure has failed, the objXL.Application.Quit line is never executed, leaving Excel in process limbo.

Try putting an error handler into your code (on error go to...) to catch and display errors, and to force a objXL.Application.Quit to be executed.

John

[ham355]

Yes yes yes yes I could kiss you guys, simple on the face of it, but adding a full stop (I had to think a bit there when you said period, coming from the UK) in front of the selection after with has solved my issues!

Thank you very much!

[pbaldy]

Happy to help!

[ghnogueira]

Hello there.

I'm having the same problem, and looked my code a thousand times looking where else I could reference but couldn't find it.

Please help me out!

Thanks!

Private Sub bot_Exportar_Click()    
    Dim myQueryName As String
    Dim myExportFileName As String
    
    Dim xlApp As New Excel.Application
    Dim wb As Excel.Workbook
    
    myQueryName = "qry_Dados"
    myExportFileName = PATH_EXPORT & "Exemplo Relatório Sales Funnel.xlsx"
    Set wb = xlApp.Workbooks.Open(myExportFileName, True, False)
    wb.Sheets(1).Rows("1:" & Rows.Count).ClearContents
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, myQueryName, myExportFileName, False, "cpo_Import"
    
    wb.Close True
    xlApp.Quit
    
    Set wb = Nothing
    Set xlApp = Nothing


End Sub

[pbaldy]

How about here:

Rows.Count

[ghnogueira]

How about here:

Rows.Count

If I'm not mistaken, I tried putting "wb.Rows.Count" there and it returned an error.

I'll try it out tomorrow when I get back to the DB and come back here.

Thanks!

[ghnogueira]

Yeah, it gives me error '438', saying the object doesn't accept the property or method.

[pbaldy]

Shot in the dark, but did you try with the Excel variable?

[ghnogueira]

Shot in the dark, but did you try with the Excel variable?

BINGO!!!!!!!

I'll be honest to say I didn't get why it worked with the excel variable since, in my head, I'm counting the number of rows of the spreadsheet, and not of the excel application. Buuut, it worked out great.

Thanks!!!

[pbaldy]

Happy to help!