Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
Discussion GroupsFormsForms ProgrammingQueriesModules / DAO / VBAReports / PrintingMacrosDatabase DesignSecurityConversionImporting / LinkingSQL Server / ADPMultiuser / NetworkingReplicationSetup / ConfigurationDeveloper ToolkitsActiveX ControlsNew UsersGeneral 1General 2
Access DirectoryToolsTutorialsUser Groups
Related Topics
SQL ServerOther DB ProductsMS OfficeMore Topics ...
MS Access Forum / Modules / DAO / VBA / April 2008

Tip: Looking for answers? Try searching our database.

Extra Excel Instance

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Michele_L - 23 Apr 2008 21:05 GMT
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 = "michele_lanik@yahoo.com"
 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

Signature

Michele_L

Reply to this Message
Jeanette Cunningham - 23 Apr 2008 23:41 GMT
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

> I've read prior posts on getting rid of extra instances of Excel that
> using
[quoted text clipped - 243 lines]
>
> MsgBox "Done :)", vbOKOnly
Reply to this Message
Michele_L - 24 Apr 2008 15:23 GMT
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 = "michele_lanik@yahoo.com"
 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

Signature

Michele_L

> Michele,
> at the end of the code, when you set the variables to nothing, do it in the
[quoted text clipped - 263 lines]
> >
> > MsgBox "Done :)", vbOKOnly
Reply to this Message
Jeanette Cunningham - 24 Apr 2008 21:51 GMT
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

> Dear Jeanette,
>
[quoted text clipped - 525 lines]
>> >
>> > MsgBox "Done :)", vbOKOnly
Reply to this Message
Michele_L - 24 Apr 2008 22:29 GMT
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 = "michele_lanik@yahoo.com"
 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 :)
Signature

Michele_L

> Michele,
> no can do with code for Task Manager I'm afraid.
[quoted text clipped - 284 lines]
> >>
> >> Jeanette Cunningham
Reply to this Message
Michele_L - 24 Apr 2008 22:44 GMT
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
Signature

Michele_L

> Dear Jeanette,
>
[quoted text clipped - 286 lines]
> > > exit
> > > Access after running (usually) therefore getting rid of the Excel
Reply to this Message
Jeanette Cunningham - 24 Apr 2008 23:30 GMT
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

> P.S.  I forgot to say in my previous reply the References that I used:
>
[quoted text clipped - 308 lines]
>> > > exit
>> > > Access after running (usually) therefore getting rid of the Excel
Reply to this Message
Michele_L - 25 Apr 2008 15:13 GMT
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.

Signature

Michele_L

> Michele,
> here is what I found.
[quoted text clipped - 285 lines]
> >>         .RightHeader = ""
> >>         .LeftFooter = ""
Reply to this Message
Michele_L - 25 Apr 2008 20:21 GMT
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.

Signature

Michele_L

> Dear Jeanette,
>
[quoted text clipped - 279 lines]
> > >>     With Selection
> > >>         .NumberFormat = "#,##0.000"
Reply to this Message
Michele_L - 25 Apr 2008 22:02 GMT
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 = "michele_lanik@yahoo.com"
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
Signature

Michele_L

> 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
[quoted text clipped - 273 lines]
> > > >>     excelrange = "AB3:AC" & rstlen
> > > >>     xlsheet.Range(excelrange).Select
Reply to this Message
Jeanette Cunningham - 25 Apr 2008 22:41 GMT
Michele,
well done! It is a great success when you teach yourself how to do it -
increases your understanding enormously.

Jeanette Cunningham

> Dear Jeanette,
>
[quoted text clipped - 560 lines]
>> > > >>     excelrange = "AB3:AC" & rstlen
>> > > >>     xlsheet.Range(excelrange).Select
Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.