Extra Excel Instance

Michele_L · Apr 23, 2008

I've read prior posts on getting rid of extra instances of Excel that using
the Excel application from within Access code can present. I've checked and
followed the objects created in the code, making sure to quit and set the
objects to nothing. Below is the code I've been working with, and it works
perfectly if I exit Access after it is run (which eliminates the extra
instance of Excel.) I'm using MS Access 2000, and would appreciate the help.

Dim db As DAO.Database
Dim rstlen As Integer
Dim rcs As DAO.Recordset
Dim erange As String
Dim myolapp As Outlook.Application
Dim myitem As MailItem
Dim att1 As Attachments

'DoCmd.RunMacro "M_Supplier Schedule"
Dim realcur As Variant
realcur = Now()
stnm = "U:\" & Format(realcur, "mm-dd-yyyy") & "-Supplier_Schedule.xls"
'*********************************************
'*********************************************
'*********************************************
DoCmd.OutputTo acOutputQuery, "Supplier Schedule", acFormatXLS, stnm, False
Dim appex As Object
Dim xsps As Object
Dim xlsheet As Object

Set appex = CreateObject("Excel.Application")
appex.Visible = True
appex.WindowState = xlMinimized
Set xsps = appex.Workbooks.Open(stnm)
Set xlsheet = xsps.ActiveSheet

xsps.Colors(38) = RGB(236, 239, 254)
xsps.Colors(55) = RGB(0, 0, 128)
xsps.Colors(56) = RGB(0, 0, 0)

Dim TNM As Variant
TNM = Format(realcur, "mmddyy")
xlsheet.Name = TNM & "-Supplier Schedule"

appex.Rows(1).Insert

xlsheet.Range("a1") = "Supplier Schedule As Of " & Format(realcur,
"mm-dd-yyyy")

xlsheet.Range("A2") = "SKU"
xlsheet.Range("b2") = "Division"
xlsheet.Range("c2") = "Subdivision"
xlsheet.Range("d2") = "Description"
xlsheet.Range("e2") = "Supplier #"
xlsheet.Range("f2") = "Supplier Name"
xlsheet.Range("g2") = "Supplier Addr1"
xlsheet.Range("h2") = "Supplier Addr2"
xlsheet.Range("i2") = "Supplier Addr3"
xlsheet.Range("j2") = "Supplier Addr4"
xlsheet.Range("k2") = "Supplier Addr5"
xlsheet.Range("l2") = "Zip"
xlsheet.Range("m2") = "Supplier #"
xlsheet.Range("n2") = "SKU"
xlsheet.Range("o2") = "Item Total"
xlsheet.Range("aa2") = "Family"
xlsheet.Range("ab2") = "Family Total"
xlsheet.Range("ac2") = "SKUs Per Family"
xlsheet.Range("ad2") = "Subdivision"
xlsheet.Range("ae2") = "Total Sub-Division Sum"
xlsheet.Range("af2") = "SKUs Per Sub-Division"
xlsheet.Range("ag2") = "Standard Cost"
xlsheet.Range("ah2") = "Current Price"
xlsheet.Range("ai2") = "Item Total Across"

Set db = CurrentDb()
Set rcs = db.OpenRecordset("Supplier Schedule")
rcs.MoveFirst
rcs.MoveLast

rstlen = rcs.RecordCount
rstlen = rstlen + 2
Set rcs = Nothing
Set db = Nothing
erange = "A3:ai" & rstlen
xlsheet.Range(erange).Select
With Selection
.Font.Name = "Arial"
.Font.Size = 8
.RowHeight = 12
.WrapText = True
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 56
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 56
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 56
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 56
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ColorIndex = 56
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).ColorIndex = 56
End With
xlsheet.Range("a2:AI2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.Font.ColorIndex = 55
.Font.Size = 8
.Font.Bold = True
.RowHeight = 45.75
.AutoFilter
.Interior.ColorIndex = 38
End With

xlsheet.Range("A1").Select
With Selection
.Font.Bold = True
.RowHeight = 46
.Font.ColorIndex = 55
.WrapText = False
.Font.Size = 12
.RowHeight = 35
End With
xlsheet.Range("b1").RowHeight = 35
xlsheet.Range("b2").RowHeight = 50.25
xlsheet.Columns("A").ColumnWidth = 14.01
xlsheet.Columns("B").ColumnWidth = 7.57
xlsheet.Columns("C").ColumnWidth = 24.57
xlsheet.Columns("D").ColumnWidth = 35.14
xlsheet.Columns("E").ColumnWidth = 6.71
xlsheet.Columns("F").ColumnWidth = 32.57
xlsheet.Columns("G").ColumnWidth = 31.57
xlsheet.Columns("H").ColumnWidth = 32.29
xlsheet.Columns("I").ColumnWidth = 27.86
xlsheet.Columns("J").ColumnWidth = 26.43
xlsheet.Columns("K").ColumnWidth = 26.57
xlsheet.Columns("L").ColumnWidth = 5.43
xlsheet.Columns("M").ColumnWidth = 6.86
xlsheet.Columns("N").ColumnWidth = 12.86
xlsheet.Columns("O").ColumnWidth = 7.14
xlsheet.Columns("P:Z").ColumnWidth = 6.29
xlsheet.Columns("AA").ColumnWidth = 5.01
xlsheet.Columns("AB").ColumnWidth = 6.43
xlsheet.Columns("AC").ColumnWidth = 5.01
xlsheet.Columns("AD").ColumnWidth = 24.14
xlsheet.Columns("AE").ColumnWidth = 8.01
xlsheet.Columns("AF").ColumnWidth = 6.29
xlsheet.Columns("AG").ColumnWidth = 7.43
xlsheet.Columns("AH").ColumnWidth = 6.86
xlsheet.Columns("AI").ColumnWidth = 5.71

erange = "O3:Z" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AB3:AC" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AE3:AF" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AI3:AI" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AG3:AG" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
erange = "AH3:AH" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
With xlsheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = "$A:$a"
End With
xlsheet.PageSetup.PrintArea = ""
With xlsheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&A"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P"
.RightFooter = ""
.LeftMargin = 0.0041
.RightMargin = 0.0041
.TopMargin = 0.0041
.BottomMargin = 0.36
.HeaderMargin = 0.0041
.FooterMargin = 0.0041
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 80
End With
xlsheet.Range("A1").Select
xlsheet.Range("c3").Select
appex.ActiveWindow.FreezePanes = True
xlsheet.Range("A1").Select
appex.ActiveWindow.WindowState = xlMaximized
appex.DisplayAlerts = False
xsps.SaveAs stnm

xsps.Close

appex.Quit
Set xsps = Nothing
Set appex = Nothing

Set myolapp = CreateObject("outlook.application")
Set myitem = myolapp.createitem(MailItem)
Set att1 = myitem.Attachments
att1.Add stnm
myitem.To = "(e-mail address removed)"
myitem.Subject = "Supplier Schedule As Of " & Format(realcur, "mm-dd-yyyy")
myitem.send
Set myolapp = Nothing
Set myitem = Nothing
Set att1 = Nothing

MsgBox "Done

", vbOKOnly

Jeanette Cunningham · Apr 23, 2008

Michele,
at the end of the code, when you set the variables to nothing, do it in the
reverse order in which you set them at the start of the code.
For all the excel variables, make you sure the last excel variable you set
to nothing is the variable that opened excel - in your code it is called
appex.

Your code does this line at the start
Set appex = CreateObject("Excel.Application")

When I look at the end of the code, I can't see a line where you set appex
to nothing.
I should see something like this:

If Not appex IsNothing Then
Set appex = Nothing
End If

Jeanette Cunningham

Michele_L · Apr 24, 2008

Dear Jeanette,

Thank you so much for answering so quickly

I set the xlsheet object to nothing, and rearranged the order of setting the
other objects to nothing (below), and still get the extra instance. Since I
have a slew of automated applications using code similar to this, that exit
Access after running (usually) therefore getting rid of the Excel instance,
I'm wondering if you have code that directly talks to the Task Manager,
allowing the code to close Excel instances, enabling it to be easily adapted
to other procedures.

Dim db As DAO.Database
Dim rstlen As Integer
Dim rcs As DAO.Recordset
Dim erange As String
Dim appex As Object
Dim xsps As Object
Dim xlsheet As Object
Dim myolapp As Outlook.Application
Dim myitem As MailItem
Dim att1 As Attachments
Dim realcur As Variant

'DoCmd.RunMacro "M_Supplier Schedule"

realcur = Now()
stnm = "U:\" & Format(realcur, "mm-dd-yyyy") & "-Supplier_Schedule.xls"

DoCmd.OutputTo acOutputQuery, "Supplier Schedule", acFormatXLS, stnm, False

Set appex = CreateObject("Excel.Application")
Set xsps = appex.Workbooks.Open(stnm)
Set xlsheet = xsps.ActiveSheet
appex.Visible = True
appex.WindowState = xlMinimized

xsps.Colors(38) = RGB(236, 239, 254)
xsps.Colors(55) = RGB(0, 0, 128)
xsps.Colors(56) = RGB(0, 0, 0)

Dim TNM As Variant
TNM = Format(realcur, "mmddyy")
xlsheet.Name = TNM & "-Supplier Schedule"

appex.Rows(1).Insert

xlsheet.Range("a1") = "Supplier Schedule As Of " & Format(realcur,
"mm-dd-yyyy")
xlsheet.Range("A2") = " SKU"
xlsheet.Range("b2") = "Division"
xlsheet.Range("c2") = "Subdivision"
xlsheet.Range("d2") = "Description"
xlsheet.Range("e2") = "Supplier #"
xlsheet.Range("f2") = "Supplier Name"
xlsheet.Range("g2") = "Supplier Addr1"
xlsheet.Range("h2") = "Supplier Addr2"
xlsheet.Range("i2") = "Supplier Addr3"
xlsheet.Range("j2") = "Supplier Addr4"
xlsheet.Range("k2") = "Supplier Addr5"
xlsheet.Range("l2") = "Zip"
xlsheet.Range("m2") = "Supplier #"
xlsheet.Range("n2") = " SKU"
xlsheet.Range("o2") = "Item Total"
xlsheet.Range("aa2") = "Family"
xlsheet.Range("ab2") = "Family Total"
xlsheet.Range("ac2") = "SKUs Per Family"
xlsheet.Range("ad2") = "Subdivision"
xlsheet.Range("ae2") = "Total Sub-Division Sum"
xlsheet.Range("af2") = "SKUs Per Sub-Division"
xlsheet.Range("ag2") = "Standard Cost"
xlsheet.Range("ah2") = "Current Price"
xlsheet.Range("ai2") = "Item Total Across"

Set db = CurrentDb()
Set rcs = db.OpenRecordset("Supplier Schedule")
rcs.MoveFirst
rcs.MoveLast
rstlen = rcs.RecordCount
rstlen = rstlen + 2
Set rcs = Nothing
Set db = Nothing

erange = "A3:ai" & rstlen
xlsheet.Range(erange).Select
With Selection
.Font.Name = "Arial"
.Font.Size = 8
.RowHeight = 12
.WrapText = True
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 56
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 56
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 56
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 56
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ColorIndex = 56
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).ColorIndex = 56
End With
xlsheet.Range("a2:AI2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.Font.ColorIndex = 55
.Font.Size = 8
.Font.Bold = True
.RowHeight = 45.75
.AutoFilter
.Interior.ColorIndex = 38
End With
xlsheet.Range("A1").Select
With Selection
.Font.Bold = True
.RowHeight = 46
.Font.ColorIndex = 55
.WrapText = False
.Font.Size = 12
.RowHeight = 35
End With
xlsheet.Range("b1").RowHeight = 35
xlsheet.Range("b2").RowHeight = 50.25
xlsheet.Columns("A").ColumnWidth = 14.01
xlsheet.Columns("B").ColumnWidth = 7.57
xlsheet.Columns("C").ColumnWidth = 24.57
xlsheet.Columns("D").ColumnWidth = 35.14
xlsheet.Columns("E").ColumnWidth = 6.71
xlsheet.Columns("F").ColumnWidth = 32.57
xlsheet.Columns("G").ColumnWidth = 31.57
xlsheet.Columns("H").ColumnWidth = 32.29
xlsheet.Columns("I").ColumnWidth = 27.86
xlsheet.Columns("J").ColumnWidth = 26.43
xlsheet.Columns("K").ColumnWidth = 26.57
xlsheet.Columns("L").ColumnWidth = 5.43
xlsheet.Columns("M").ColumnWidth = 6.86
xlsheet.Columns("N").ColumnWidth = 12.86
xlsheet.Columns("O").ColumnWidth = 7.14
xlsheet.Columns("P:Z").ColumnWidth = 6.29
xlsheet.Columns("AA").ColumnWidth = 5.01
xlsheet.Columns("AB").ColumnWidth = 6.43
xlsheet.Columns("AC").ColumnWidth = 5.01
xlsheet.Columns("AD").ColumnWidth = 24.14
xlsheet.Columns("AE").ColumnWidth = 8.01
xlsheet.Columns("AF").ColumnWidth = 6.29
xlsheet.Columns("AG").ColumnWidth = 7.43
xlsheet.Columns("AH").ColumnWidth = 6.86
xlsheet.Columns("AI").ColumnWidth = 5.71

erange = "O3:Z" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AB3:AC" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AE3:AF" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AI3:AI" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0"
End With
erange = "AG3:AG" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
erange = "AH3:AH" & rstlen
xlsheet.Range(erange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
With xlsheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = "$A:$a"
End With
xlsheet.PageSetup.PrintArea = ""
With xlsheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&A"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P"
.RightFooter = ""
.LeftMargin = 0.0041
.RightMargin = 0.0041
.TopMargin = 0.0041
.BottomMargin = 0.36
.HeaderMargin = 0.0041
.FooterMargin = 0.0041
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 80
End With
xlsheet.Range("A1").Select
xlsheet.Range("c3").Select
' appex.ActiveWindow.FreezePanes = True
xlsheet.Range("A1").Select
appex.ActiveWindow.WindowState = xlMaximized
appex.DisplayAlerts = False
xsps.SaveAs stnm
'xlsheet.Close
xsps.Close
appex.Quit

Set xlsheet = Nothing
Set xsps = Nothing
Set appex = Nothing

Set appex = GetObject(, "Excel.application")
appex.Quit
Set appex = Nothing

Set myolapp = CreateObject("outlook.application")
Set myitem = myolapp.createitem(MailItem)
Set att1 = myitem.Attachments
att1.Add stnm
myitem.To = "(e-mail address removed)"
myitem.Subject = "Supplier Schedule As Of " & Format(realcur, "mm-dd-yyyy")
myitem.send

Set att1 = Nothing
Set myitem = Nothing
Set myolapp = Nothing

MsgBox "Done

", vbOKOnly

Jeanette Cunningham · Apr 24, 2008

Michele,
no can do with code for Task Manager I'm afraid.
There is still a problem somewhere in the amended code.
Would you post the amended code - please the complete sub or function.
Do you use transfer spreadsheet with this particular code? sometimes the way
you code this can leave an instance of excel hanging.

Jeanette Cunningham

Michele_L · Apr 24, 2008

Dear Jeanette,

The code is below.

I used the "OutputTo" to get the query into Excel. The code can be used in
any Access database if you had a bogus query called "Supplier Schedule" maybe
using a single table with only one field of data, and copy and pasting the
code beneath a command button. It will place the Excel file in the C:\
directory.

Private Sub Command0_Click()
'On Error GoTo Err_Command0_Click
'***Declarations
Dim db As DAO.Database
Dim rstlen As Integer
Dim rcs As DAO.Recordset
Dim excelrange As String
Dim appex As Object
Dim xsps As Object
Dim xlsheet As Object
Dim myolapp As Outlook.Application
Dim myitem As MailItem
Dim att1 As Attachments
Dim realcur As Variant
Dim TNM As Variant

'DoCmd.RunMacro "M_Supplier Schedule"

realcur = Now()
stnm = "C:\" & Format(realcur, "mm-dd-yyyy") & "-Supplier_Schedule.xls"

'***Export query
DoCmd.OutputTo acOutputQuery, "Supplier Schedule", acFormatXLS, stnm, False

'***Set Excel objects
Set appex = CreateObject("Excel.Application")
Set xsps = appex.Workbooks.Open(stnm)
Set xlsheet = xsps.ActiveSheet
appex.Visible = True
appex.WindowState = xlMinimized

'***Excel formatting
xsps.Colors(38) = RGB(236, 239, 254)
xsps.Colors(55) = RGB(0, 0, 128)
xsps.Colors(56) = RGB(0, 0, 0)

TNM = Format(realcur, "mmddyy")
xlsheet.Name = TNM & "-Supplier Schedule"

appex.Rows(1).Insert

xlsheet.Range("a1") = "Supplier Schedule As Of " & Format(realcur,
"mm-dd-yyyy")
xlsheet.Range("A2") = " SKU"
xlsheet.Range("b2") = "Division"
xlsheet.Range("c2") = "Subdivision"
xlsheet.Range("d2") = "Description"
xlsheet.Range("e2") = "Supplier #"
xlsheet.Range("f2") = "Supplier Name"
xlsheet.Range("g2") = "Supplier Addr1"
xlsheet.Range("h2") = "Supplier Addr2"
xlsheet.Range("i2") = "Supplier Addr3"
xlsheet.Range("j2") = "Supplier Addr4"
xlsheet.Range("k2") = "Supplier Addr5"
xlsheet.Range("l2") = "Zip"
xlsheet.Range("m2") = "Supplier #"
xlsheet.Range("n2") = " SKU"
xlsheet.Range("o2") = "Item Total"
xlsheet.Range("aa2") = "Family"
xlsheet.Range("ab2") = "Family Total"
xlsheet.Range("ac2") = "SKUs Per Family"
xlsheet.Range("ad2") = "Subdivision"
xlsheet.Range("ae2") = "Total Sub-Division Sum"
xlsheet.Range("af2") = "SKUs Per Sub-Division"
xlsheet.Range("ag2") = "Standard Cost"
xlsheet.Range("ah2") = "Current Price"
xlsheet.Range("ai2") = "Item Total Across"

'***Get length of Excel File
Set db = CurrentDb()
Set rcs = db.OpenRecordset("Supplier Schedule")
rcs.MoveFirst
rcs.MoveLast
rstlen = rcs.RecordCount
rstlen = rstlen + 2
Set rcs = Nothing
Set db = Nothing

'***Format Excel File
excelrange = "A3:ai" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.Font.Name = "Arial"
.Font.Size = 8
.RowHeight = 12
.WrapText = True
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 56
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 56
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 56
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 56
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ColorIndex = 56
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).ColorIndex = 56
End With
xlsheet.Range("a2:AI2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.Font.ColorIndex = 55
.Font.Size = 8
.Font.Bold = True
.RowHeight = 45.75
.AutoFilter
.Interior.ColorIndex = 38
End With
xlsheet.Range("A1").Select
With Selection
.Font.Bold = True
.RowHeight = 46
.Font.ColorIndex = 55
.WrapText = False
.Font.Size = 12
.RowHeight = 35
End With
xlsheet.Range("b1").RowHeight = 35
xlsheet.Range("b2").RowHeight = 50.25
xlsheet.Columns("A").ColumnWidth = 14.01
xlsheet.Columns("B").ColumnWidth = 7.57
xlsheet.Columns("C").ColumnWidth = 24.57
xlsheet.Columns("D").ColumnWidth = 35.14
xlsheet.Columns("E").ColumnWidth = 6.71
xlsheet.Columns("F").ColumnWidth = 32.57
xlsheet.Columns("G").ColumnWidth = 31.57
xlsheet.Columns("H").ColumnWidth = 32.29
xlsheet.Columns("I").ColumnWidth = 27.86
xlsheet.Columns("J").ColumnWidth = 26.43
xlsheet.Columns("K").ColumnWidth = 26.57
xlsheet.Columns("L").ColumnWidth = 5.43
xlsheet.Columns("M").ColumnWidth = 6.86
xlsheet.Columns("N").ColumnWidth = 12.86
xlsheet.Columns("O").ColumnWidth = 7.14
xlsheet.Columns("P:Z").ColumnWidth = 6.29
xlsheet.Columns("AA").ColumnWidth = 5.01
xlsheet.Columns("AB").ColumnWidth = 6.43
xlsheet.Columns("AC").ColumnWidth = 5.01
xlsheet.Columns("AD").ColumnWidth = 24.14
xlsheet.Columns("AE").ColumnWidth = 8.01
xlsheet.Columns("AF").ColumnWidth = 6.29
xlsheet.Columns("AG").ColumnWidth = 7.43
xlsheet.Columns("AH").ColumnWidth = 6.86
xlsheet.Columns("AI").ColumnWidth = 5.71

excelrange = "O3:Z" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0"
End With
excelrange = "AB3:AC" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0"
End With
excelrange = "AE3:AF" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0"
End With
excelrange = "AI3:AI" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0"
End With
excelrange = "AG3:AG" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
excelrange = "AH3:AH" & rstlen
xlsheet.Range(excelrange).Select
With Selection
.NumberFormat = "#,##0.000"
End With
'***Define Print Layout
With xlsheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = "$A:$a"
End With
xlsheet.PageSetup.PrintArea = ""
With xlsheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&A"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P"
.RightFooter = ""
.LeftMargin = 0.0041
.RightMargin = 0.0041
.TopMargin = 0.0041
.BottomMargin = 0.36
.HeaderMargin = 0.0041
.FooterMargin = 0.0041
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 80
End With

xlsheet.Range("A1").Select
appex.ActiveWindow.WindowState = xlMaximized
xlsheet.Range("A1").Select
xlsheet.Range("c3").Select
appex.ActiveWindow.FreezePanes = True
appex.DisplayAlerts = False
xsps.SaveAs stnm
'***Get out of Objects and set them to nothing
xsps.Close
appex.Quit

Set xlsheet = Nothing
Set xsps = Nothing
Set appex = Nothing

'***an unsuccessful try to close an Excel instance
Set appex = GetObject(, "Excel.application")
appex.Quit
Set appex = Nothing

'***use outlook to send out the Excel file
Set myolapp = CreateObject("outlook.application")
Set myitem = myolapp.createitem(MailItem)
Set att1 = myitem.Attachments
att1.Add stnm
myitem.To = "(e-mail address removed)"
myitem.Subject = "Supplier Schedule As Of " & Format(realcur, "mm-dd-yyyy")
myitem.send

'***set outlook objects to nothing
Set att1 = Nothing
Set myitem = Nothing
Set myolapp = Nothing

MsgBox "Done

", vbOKOnly

'Exit_Command0_Click:
' Exit Sub
'Err_Command0_Click:
'MsgBox Err.Description
' Resume Exit_Command0_Click
End Sub

I reallly appreciate your help

Michele_L · Apr 24, 2008

P.S. I forgot to say in my previous reply the References that I used:

Visual Basic for Applications
Microsoft Access 9.0 Object Library
OLE Automation
Microsoft ActiveX Data Objects 2.5 Library
Microsoft DAO 3.6 Object Library
Microsoft Excel 9.0 Object Library
Microsoft Office 9.0 Object Library
Microsoft Outlook 9.0 Object Library
Microsoft Visual Basic for Applications Extensibiltiy 5.3
Microsoft Shell Controls and Automation

Jeanette Cunningham · Apr 24, 2008

Michele,
here is what I found.
First I copied and pasted your code into a new form.
Next I commented out all the code for Outlook
Next I commented out all the code that formatted the excel worksheet.
I had to add an extra declaration for stnm -- Dim stnm As String

I was left with this code:
----------------------------------
Private Sub ExportMyData()

Dim db As DAO.Database
Dim rstlen As Integer
Dim rcs As DAO.Recordset
Dim excelrange As String
Dim appex As Object
Dim xsps As Object
Dim xlsheet As Object
Dim realcur As Variant
Dim TNM As Variant
Dim stnm As String

realcur = Now()
stnm = "C:\" & Format(realcur, "mm-dd-yyyy") & "-Supplier_Schedule.xls"

'***Export query
DoCmd.OutputTo acOutputQuery, "qrySnowii", acFormatXLS, stnm, False

'***Set Excel objects
Set appex = CreateObject("Excel.Application")
Set xsps = appex.Workbooks.Open(stnm)
Set xlsheet = xsps.ActiveSheet
appex.Visible = True

TNM = Format(realcur, "mmddyy")
xlsheet.Name = TNM & "-Supplier Schedule"

xsps.Close
appex.Quit

Set xlsheet = Nothing
Set xsps = Nothing
Set appex = Nothing

MsgBox "Done

", vbOKOnly

End Sub
---------------------------------------

The above worked beautifully. I checked Task Manager - there were no
instances of excel left running.
This suggests that there is no problem with any of the excel code.

Next I added the code for outlook back in by uncommenting it.
I added all the references you supplied.
I could not get the code to compile.
My version of the reference for the Microsoft Office Object Library is 12.0,
not 11.0 as you have.
There was an error on this line
--> Set myitem = myolapp.createitem(MailItem)
I don't have much experience with sending email yet, so will leave that for
you to sort out.

I suggest that you also do a trial where you comment out all the code to do
with outlook and see if the excel part works and closes all excel instances.
When you get this working correctly, then add back in the code that sends
the email.

Jeanette Cunningham

Michele_L · Apr 25, 2008

Dear Jeanette,

Thank you for your time. I wonder why the code:

Dim appex As Object
Set appex = GetObject(, "Excel.application")
appex.Quit
Set appex = Nothing

wouldn't work as standalone code to get rid of an extra Excel instance.

Michele_L · Apr 25, 2008

P.S. Even though the outlook code doesn't seem to affect the Excel instance,
by testing the procedure, it turns out that if I stop the code after saving
the Excel file, (by the way it is alright to just use xsps.save, as it saves
the correct name and information as xsps.SaveAs stnm and eliminates using the
line appex.DisplayAlerts = False), and manually exit the Excel file that is
then open, the Excel instance goes away. So I see why you would think it is
the outlook code, but getting rid of it doesn't help. The only statements
left are the quitting of appex and the setting of all to nothing. I'll try
creating the Excel application instance first, and then Getting the Excel
application to use the code on.

Michele_L · Apr 25, 2008

Dear Jeanette,

SUCCESS!!!!! THANKS!!!!!!!!!!!!!!!!!

Below is the code that worked! Not using "With Selection...End With" is
the key.
The commented lines show what I mean:
Private Sub Command0_Click()
On Error GoTo Err_Command0_Click
'***Declarations
Dim db As DAO.Database
Dim rstlen As Integer
Dim rcs As DAO.Recordset
Dim excelrange As String
Dim appex As Object
Dim xsps As Object
Dim xlsheet As Object
Dim myolapp As Outlook.Application
Dim myitem As MailItem
Dim att1 As Attachments
Dim realcur As Variant
Dim TNM As Variant
Dim stnm As String

realcur = Now()
stnm = "U:\" & Format(realcur, "mm-dd-yyyy") & "-Supplier_Schedule.xls"

'***Export query
DoCmd.OutputTo acOutputQuery, "Supplier Schedule", acFormatXLS, stnm, False

'***Set Excel objects
Set appex = CreateObject("Excel.Application")
Set xsps = appex.Workbooks.Open(stnm)
Set xlsheet = xsps.ActiveSheet
appex.Visible = True
'appex.WindowState = xlMinimized

'***Excel formatting
xsps.Colors(38) = RGB(236, 239, 254)
xsps.Colors(55) = RGB(0, 0, 128)
xsps.Colors(56) = RGB(0, 0, 0)

TNM = Format(realcur, "mmddyy")
xlsheet.Name = TNM & "-Supplier Schedule"
appex.Rows(1).Insert
xlsheet.Range("a1") = "Supplier Schedule As Of " & Format(realcur,
"mm-dd-yyyy")
xlsheet.Range("A2") = " SKU"
xlsheet.Range("b2") = "Division"
xlsheet.Range("c2") = "Subdivision"
xlsheet.Range("d2") = "Description"
xlsheet.Range("e2") = "Supplier #"
xlsheet.Range("f2") = "Supplier Name"
xlsheet.Range("g2") = "Supplier Addr1"
xlsheet.Range("h2") = "Supplier Addr2"
xlsheet.Range("i2") = "Supplier Addr3"
xlsheet.Range("j2") = "Supplier Addr4"
xlsheet.Range("k2") = "Supplier Addr5"
xlsheet.Range("l2") = "Zip"
xlsheet.Range("m2") = "Supplier #"
xlsheet.Range("n2") = " SKU"
xlsheet.Range("o2") = "Item Total"
xlsheet.Range("aa2") = "Family"
xlsheet.Range("ab2") = "Family Total"
xlsheet.Range("ac2") = "SKUs Per Family"
xlsheet.Range("ad2") = "Subdivision"
xlsheet.Range("ae2") = "Total Sub-Division Sum"
xlsheet.Range("af2") = "SKUs Per Sub-Division"
xlsheet.Range("ag2") = "Standard Cost"
xlsheet.Range("ah2") = "Current Price"
xlsheet.Range("ai2") = "Item Total Across"

'***Get length of Excel File
Set db = CurrentDb()
Set rcs = db.OpenRecordset("Supplier Schedule")
rcs.MoveFirst
rcs.MoveLast
rstlen = rcs.RecordCount
rstlen = rstlen + 2
Set rcs = Nothing
Set db = Nothing
'***Format Excel File
excelrange = "A3:ai" & rstlen
'xlsheet.Range(excelrange).Select
xlsheet.Range(excelrange).Font.Name = "Arial"
xlsheet.Range(excelrange).Font.Size = 8
xlsheet.Range(excelrange).RowHeight = 12
xlsheet.Range(excelrange).WrapText = True
xlsheet.Range(excelrange).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlsheet.Range(excelrange).Borders(xlEdgeLeft).ColorIndex = 56
xlsheet.Range(excelrange).Borders(xlEdgeTop).LineStyle = xlContinuous
xlsheet.Range(excelrange).Borders(xlEdgeTop).ColorIndex = 56
xlsheet.Range(excelrange).Borders(xlEdgeBottom).LineStyle =
xlContinuous
xlsheet.Range(excelrange).Borders(xlEdgeBottom).ColorIndex = 56
xlsheet.Range(excelrange).Borders(xlEdgeRight).LineStyle =
xlContinuous
xlsheet.Range(excelrange).Borders(xlEdgeRight).ColorIndex = 56
xlsheet.Range(excelrange).Borders(xlInsideVertical).LineStyle =
xlContinuous
xlsheet.Range(excelrange).Borders(xlInsideVertical).ColorIndex = 56
xlsheet.Range(excelrange).Borders(xlInsideHorizontal).LineStyle
=xlContinuous
xlsheet.Range(excelrange).Borders(xlInsideHorizontal).ColorIndex = 56
'xlsheet.Range("a2:AI2").Select
'With Selection
xlsheet.Range("a2:AI2").HorizontalAlignment = xlLeft
xlsheet.Range("a2:AI2").VerticalAlignment = xlTop
xlsheet.Range("a2:AI2").WrapText = True
xlsheet.Range("a2:AI2").Orientation = 0
xlsheet.Range("a2:AI2").AddIndent = False
xlsheet.Range("a2:AI2").ShrinkToFit = False
xlsheet.Range("a2:AI2").Font.ColorIndex = 55
xlsheet.Range("a2:AI2").Font.Size = 8
xlsheet.Range("a2:AI2").Font.Bold = True
xlsheet.Range("a2:AI2").RowHeight = 45.75
xlsheet.Range("a2:AI2").AutoFilter
xlsheet.Range("a2:AI2").Interior.ColorIndex = 38
' End With
' xlsheet.Range("A1").Select
'With Selection
xlsheet.Range("A1").Font.Bold = True
xlsheet.Range("A1").RowHeight = 46
xlsheet.Range("A1").Font.ColorIndex = 55
xlsheet.Range("A1").WrapText = False
xlsheet.Range("A1").Font.Size = 12
xlsheet.Range("A1").RowHeight = 35
'End With
xlsheet.Range("b1").RowHeight = 35
xlsheet.Range("b2").RowHeight = 50.25
xlsheet.Columns("A").ColumnWidth = 14.01
xlsheet.Columns("B").ColumnWidth = 7.57
xlsheet.Columns("C").ColumnWidth = 24.57
xlsheet.Columns("D").ColumnWidth = 35.14
xlsheet.Columns("E").ColumnWidth = 6.71
xlsheet.Columns("F").ColumnWidth = 32.57
xlsheet.Columns("G").ColumnWidth = 31.57
xlsheet.Columns("H").ColumnWidth = 32.29
xlsheet.Columns("I").ColumnWidth = 27.86
xlsheet.Columns("J").ColumnWidth = 26.43
xlsheet.Columns("K").ColumnWidth = 26.57
xlsheet.Columns("L").ColumnWidth = 5.43
xlsheet.Columns("M").ColumnWidth = 6.86
xlsheet.Columns("N").ColumnWidth = 12.86
xlsheet.Columns("O").ColumnWidth = 7.14
xlsheet.Columns("P:Z").ColumnWidth = 6.29
xlsheet.Columns("AA").ColumnWidth = 5.01
xlsheet.Columns("AB").ColumnWidth = 6.43
xlsheet.Columns("AC").ColumnWidth = 5.01
xlsheet.Columns("AD").ColumnWidth = 24.14
xlsheet.Columns("AE").ColumnWidth = 8.01
xlsheet.Columns("AF").ColumnWidth = 6.29
xlsheet.Columns("AG").ColumnWidth = 7.43
xlsheet.Columns("AH").ColumnWidth = 6.86
xlsheet.Columns("AI").ColumnWidth = 5.71

excelrange = "O3:Z" & rstlen
'xlsheet.Range(excelrange).Select
'with Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0"
'End With
excelrange = "AB3:AC" & rstlen
'xlsheet.Range(excelrange).Select
'With Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0"
'End With
excelrange = "AE3:AF" & rstlen
'xlsheet.Range(excelrange).Select
'with Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0"
'End With
excelrange = "AI3:AI" & rstlen
'xlsheet.Range(excelrange).Select
'With Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0"
'end With
excelrange = "AG3:AG" & rstlen
'xlsheet.Range(excelrange).Select
'With Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0.000"
'End With
excelrange = "AH3:AH" & rstlen
'xlsheet.Range(excelrange).Select
'With Selection
xlsheet.Range(excelrange).NumberFormat = "#,##0.000"
'End With
'***Define Print Layout
'With xlsheet.PageSetup
xlsheet.PageSetup.PrintTitleRows = "$1:$2"
xlsheet.PageSetup.PrintTitleColumns = "$A:$a"
'End With
xlsheet.PageSetup.PrintArea = ""
'With xlsheet.PageSetup
xlsheet.PageSetup.LeftHeader = ""
xlsheet.PageSetup.CenterHeader = "&A"
xlsheet.PageSetup.RightHeader = ""
xlsheet.PageSetup.LeftFooter = ""
xlsheet.PageSetup.CenterFooter = "Page &P"
xlsheet.PageSetup.RightFooter = ""
xlsheet.PageSetup.LeftMargin = 0.0041
xlsheet.PageSetup.RightMargin = 0.0041
xlsheet.PageSetup.TopMargin = 0.0041
xlsheet.PageSetup.BottomMargin = 0.36
xlsheet.PageSetup.HeaderMargin = 0.0041
xlsheet.PageSetup.FooterMargin = 0.0041
xlsheet.PageSetup.PrintHeadings = False
xlsheet.PageSetup.PrintGridlines = False
xlsheet.PageSetup.PrintComments = xlPrintNoComments
xlsheet.PageSetup.PrintQuality = 300
xlsheet.PageSetup.CenterHorizontally = False
xlsheet.PageSetup.CenterVertically = False
xlsheet.PageSetup.Orientation = xlLandscape
xlsheet.PageSetup.Draft = False
xlsheet.PageSetup.PaperSize = xlPaperLegal
xlsheet.PageSetup.FirstPageNumber = xlAutomatic
xlsheet.PageSetup.Order = xlOverThenDown
xlsheet.PageSetup.BlackAndWhite = False
xlsheet.PageSetup.Zoom = 80
'End With

xlsheet.Range("A1").Select
appex.ActiveWindow.WindowState = xlMaximized
xlsheet.Range("A1").Select
xlsheet.Range("c3").Select
appex.ActiveWindow.FreezePanes = True
appex.DisplayAlerts = False
'xsps.SaveAs stnm
xsps.Save
'***Get out of Objects and set them to nothing
xsps.Close
appex.Quit
Set xlsheet = Nothing
Set xsps = Nothing
Set appex = Nothing

'***use outlook to send out the Excel file
Set myolapp = CreateObject("outlook.application")
Set myitem = myolapp.createitem(MailItem)
Set att1 = myitem.Attachments
att1.Add stnm

myitem.To = "(e-mail address removed)"
myitem.Subject = "Supplier Schedule As Of " & Format(realcur, "mm-dd-yyyy")
myitem.send

'***set outlook objects to nothing
Set att1 = Nothing
Set myitem = Nothing
Set myolapp = Nothing

MsgBox "Done

", vbOKOnly
Exit_Command0_Click:
Exit Sub

Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click

End Sub

Jeanette Cunningham · Apr 25, 2008

Michele,
well done! It is a great success when you teach yourself how to do it -
increases your understanding enormously.

Jeanette Cunningham

Export to Excel: 2nd, 3rd, etc excel files not opening up	7	Feb 25, 2008
Excel won't go away	10	Nov 11, 2009
From Access Automate Excel to transfer cell values to form controls - possible?	6	Aug 5, 2004
Excel Invisible after Automation	1	Aug 5, 2005
At my wits end...abt launching document once file is exported to excel.	5	May 23, 2006
Run-Time Error 91 Help needed	3	May 11, 2007
Fully Qualifying - ActiveCell.SpecialCells(xlLastCell)).Select	3	Jul 26, 2006
Create a report page???	2	Jan 29, 2008

Extra Excel Instance

Michele_L

Jeanette Cunningham

Michele_L

Jeanette Cunningham

Michele_L

Michele_L

Jeanette Cunningham

Michele_L

Michele_L

Michele_L

Jeanette Cunningham

Ask a Question

Similar Threads