Excel won't go away

G

Glen Wood

I have tried several variations of the following function, but can't seem to
get excel to quit at the end if I have all the excel formating in place. It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated, "yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable, "table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tn, wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for" &
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " & maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" & "&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " & Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function
 
K

Ken Snell

Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When you use
any of the "Active" objects, ACCESS creates a new reference to the EXCEL
object, which then isn't being closed. Replace this line with a specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've closed
the xlbook object. Always destroy references to objects that are referenced
through other objects BEFORE you destroy/close the parent object - in this
case, you've closed the workbook file while still having a reference to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
I have tried several variations of the following function, but can't seem
to
get excel to quit at the end if I have all the excel formating in place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated, "yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable, "table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for" &
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" & "&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " & Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function
Click to expand...
 
G

Glen Wood

Well, I made your suggested changes, unfortunately no difference. At the end
of the function after the xl.quit I have a getobject to see if excel is still
there I get a excel found 0 msgbox and even after issuing another quit it's
still there. This is getting very frustrating.

Ken Snell said:
Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When you use
any of the "Active" objects, ACCESS creates a new reference to the EXCEL
object, which then isn't being closed. Replace this line with a specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've closed
the xlbook object. Always destroy references to objects that are referenced
through other objects BEFORE you destroy/close the parent object - in this
case, you've closed the workbook file while still having a reference to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
I have tried several variations of the following function, but can't seem
to
get excel to quit at the end if I have all the excel formating in place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated, "yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable, "table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for" &
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" & "&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " & Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function
Click to expand...


.
Click to expand...
 
K

Ken Snell

I missed one other thing that may be causing your problem.

ActiveWindow.FreezePanes = True

You need to use the xlSheet object to do this code, if that is the sheet
that is the "active" one.


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
Well, I made your suggested changes, unfortunately no difference. At the
end
of the function after the xl.quit I have a getobject to see if excel is
still
there I get a excel found 0 msgbox and even after issuing another quit
it's
still there. This is getting very frustrating.

Ken Snell said:
Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When you
use
any of the "Active" objects, ACCESS creates a new reference to the EXCEL
object, which then isn't being closed. Replace this line with a specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've
closed
the xlbook object. Always destroy references to objects that are
referenced
through other objects BEFORE you destroy/close the parent object - in
this
case, you've closed the workbook file while still having a reference to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
I have tried several variations of the following function, but can't
seem
to
get excel to quit at the end if I have all the excel formating in
place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to
create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated, "yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable, "table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for" &
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" &
"&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " & Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function
Click to expand...


.
Click to expand...
Click to expand...
 
J

JP

Ken,

The whole code is prefixed with "On Error Resume Next", it probably
wouldn't make a difference.

--JP
 
K

Ken Snell

I fail to understand what the On Error statement would have to do with a
residual instance of EXCEL. Uses of "Active" statements that are prevalent
in EXCEL code are common causes of residual EXCEL instances when automating
EXCEL from ACCESS.
 
J

JP

It doesn't have anything to do with it, that was my point. What I
meant was, ActiveWindow isn't pointing to any Excel object, and Access
doesn't have an ActiveWindow object. So how would Access know that
it's an Excel statement and needs to keep Excel alive?

I'm curious to know if the OP has solved the problem.

--JP
 
G

Glen Wood

I added option explicit and found the freesepanes issue, it's an application
level setting (i.e. xl.activewindow.freezepanes = true)
I also tried splitting out all excel processing into a separate routine,
strange that if I strip out all the formatting commands an just open and
close the xls files, excel will go away, when I put them back in it doesn't.
This is driving me crazy.

Ken Snell said:
I missed one other thing that may be causing your problem.

ActiveWindow.FreezePanes = True

You need to use the xlSheet object to do this code, if that is the sheet
that is the "active" one.


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
Well, I made your suggested changes, unfortunately no difference. At the
end
of the function after the xl.quit I have a getobject to see if excel is
still
there I get a excel found 0 msgbox and even after issuing another quit
it's
still there. This is getting very frustrating.

Ken Snell said:
Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When you
use
any of the "Active" objects, ACCESS creates a new reference to the EXCEL
object, which then isn't being closed. Replace this line with a specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've
closed
the xlbook object. Always destroy references to objects that are
referenced
through other objects BEFORE you destroy/close the parent object - in
this
case, you've closed the workbook file while still having a reference to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


I have tried several variations of the following function, but can't
seem
to
get excel to quit at the end if I have all the excel formating in
place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to
create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated, "yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable, "table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for" &
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" &
"&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " & Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function



.
Click to expand...
Click to expand...


.
Click to expand...
 
K

Ken Snell

A few more things to try....

Change this code:
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With

to this:
Dim xCell As Object
With xlsheet
For Each xCell In .Range("A1", "O1")
xCell.Font.Bold = True
Next xCell
End With


I'd take out this step:
xlsheet.Activate

It's unneccesary because xlsheet refers to a specific worksheet, and you
don't need that sheet to be "active" in order to do things with/on that
sheet.


If EXCEL instance still persists, add back formatting code one block at a
time in your "stripped out" code. See which one is causing the instance.
That should help narrow down the cause.

I note a few other things in your code.

Dim mindate, maxdata As Date
The above statement is dimensioning mindate as a Variant variable, and
maxdata as a Date variable. If you want both to be Date:
Dim mindate As Date, maxdata As Date


You're using xlLandscape as an intrinsic constant:
.Orientation = xlLandscape

However, ACCESS has no knowledge of EXCEL's instrinsic constants unless you
have a Reference set to EXCEL library in your ACCESS database. So you might
be better if you use
.Orientation = 2 ' xlLandscape value is 2

--

Ken Snell
http://www.accessmvp.com/KDSnell/



Glen Wood said:
I added option explicit and found the freesepanes issue, it's an
application
level setting (i.e. xl.activewindow.freezepanes = true)
I also tried splitting out all excel processing into a separate routine,
strange that if I strip out all the formatting commands an just open and
close the xls files, excel will go away, when I put them back in it
doesn't.
This is driving me crazy.

Ken Snell said:
I missed one other thing that may be causing your problem.

ActiveWindow.FreezePanes = True

You need to use the xlSheet object to do this code, if that is the sheet
that is the "active" one.


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Glen Wood said:
Well, I made your suggested changes, unfortunately no difference. At
the
end
of the function after the xl.quit I have a getobject to see if excel is
still
there I get a excel found 0 msgbox and even after issuing another quit
it's
still there. This is getting very frustrating.

:

Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When
you
use
any of the "Active" objects, ACCESS creates a new reference to the
EXCEL
object, which then isn't being closed. Replace this line with a
specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've
closed
the xlbook object. Always destroy references to objects that are
referenced
through other objects BEFORE you destroy/close the parent object - in
this
case, you've closed the workbook file while still having a reference
to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


I have tried several variations of the following function, but can't
seem
to
get excel to quit at the end if I have all the excel formating in
place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to
create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated,
"yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable,
"table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of
the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for"
&
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" &
"&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " &
Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function



.
Click to expand...


.
Click to expand...
Click to expand...
 
A

AccessVandal via AccessMonster.com

Do you really need to close and open again?

xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")

If Err.Number <> 0 Then '<<<< don't really understand this part
'<<<< why would you expect an error?
MsgBox "Excel not found " & Err.Number & " " & Err.Description

'I find this part of the code did not close after setting xl
'You might want to include here? set xl = nothing?

Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing

'You did it here but not above or might as well move out of the IfThenElse

End If
Set f = Nothing
Set fc = Nothing
Set fs = Nothing

End Function
Glen Wood wrote:
 
G

Glen Wood

Thanks for taking the time to look at this and your suggestions. I actually
moved this application to the server where it's going to live and surprise,
it works just fine and excel goes away when it's done. Must be something to
do with my laptop. Typical.

Ken Snell said:
A few more things to try....

Change this code:
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With

to this:
Dim xCell As Object
With xlsheet
For Each xCell In .Range("A1", "O1")
xCell.Font.Bold = True
Next xCell
End With


I'd take out this step:
xlsheet.Activate

It's unneccesary because xlsheet refers to a specific worksheet, and you
don't need that sheet to be "active" in order to do things with/on that
sheet.


If EXCEL instance still persists, add back formatting code one block at a
time in your "stripped out" code. See which one is causing the instance.
That should help narrow down the cause.

I note a few other things in your code.

Dim mindate, maxdata As Date
The above statement is dimensioning mindate as a Variant variable, and
maxdata as a Date variable. If you want both to be Date:
Dim mindate As Date, maxdata As Date


You're using xlLandscape as an intrinsic constant:
.Orientation = xlLandscape

However, ACCESS has no knowledge of EXCEL's instrinsic constants unless you
have a Reference set to EXCEL library in your ACCESS database. So you might
be better if you use
.Orientation = 2 ' xlLandscape value is 2

--

Ken Snell
http://www.accessmvp.com/KDSnell/



Glen Wood said:
I added option explicit and found the freesepanes issue, it's an
application
level setting (i.e. xl.activewindow.freezepanes = true)
I also tried splitting out all excel processing into a separate routine,
strange that if I strip out all the formatting commands an just open and
close the xls files, excel will go away, when I put them back in it
doesn't.
This is driving me crazy.

Ken Snell said:
I missed one other thing that may be causing your problem.

ActiveWindow.FreezePanes = True

You need to use the xlSheet object to do this code, if that is the sheet
that is the "active" one.


--

Ken Snell
http://www.accessmvp.com/KDSnell/


Well, I made your suggested changes, unfortunately no difference. At
the
end
of the function after the xl.quit I have a getobject to see if excel is
still
there I get a excel found 0 msgbox and even after issuing another quit
it's
still there. This is getting very frustrating.

:

Two things jump out at me.

This code line:
Set xlsheet = xl.ActiveSheet
likely is the primary source of your Excel instance remaining. When
you
use
any of the "Active" objects, ACCESS creates a new reference to the
EXCEL
object, which then isn't being closed. Replace this line with a
specific
reference to a specific worksheet, for example:
Set xlsheet = xlbook.Worksheets(1)


Also, you do not destroy your reference to xlsheet until after you've
closed
the xlbook object. Always destroy references to objects that are
referenced
through other objects BEFORE you destroy/close the parent object - in
this
case, you've closed the workbook file while still having a reference
to a
worksheet within that file.

Set xlsheet = Nothing
xlbook.Save
xlbook.Close
Set xlbook = Nothing


--

Ken Snell
http://www.accessmvp.com/KDSnell/


I have tried several variations of the following function, but can't
seem
to
get excel to quit at the end if I have all the excel formating in
place.
It
seems to lose it's connection to excel. Someone got any ideas?

Function convert_files() As Boolean
On Error Resume Next
DoCmd.SetWarnings False
Dim xl As Object
Set xl = CreateObject("Excel.application")
xl.Application.Visible = False
xl.Application.UserControl = False
xl.DisplayAlerts = False
xl.Interactive = False
xl.ScreenUpdating = False
Dim xlbook As Object
Dim xlsheet As Object
Dim fs, f, f1, fc, s, wk, firsttime, tn, fn, qt, ch
Dim mindate, maxdata As Date
Let firsttime = True
Let qt = "Query_template"
Set fs = CreateObject("Scripting.FileSystemObject")
'
' clear archive directory
'
fs.deletefile "C:\KH\Archived\*.csv", True
'
' setup directory search for csv files
'
Set f = fs.GetFolder("C:\KH")
Set fc = f.Files
For Each f1 In fc
If Right(f1.Name, 3) = "csv" Then
'
' create xls file name from csv file namefrom template to
create
xls file
'
Let tn = Mid(f1.Name, 4, 3) & Mid(f1.Name, 8, 4)
Let wk = "C:\KH\LD_" & tn & Format(f1.DateCreated,
"yyyymmdd") &
".xls"
'
' create a work table from the table template 1 time
'
If firsttime = True Then
DoCmd.CopyObject , "work_table", acTable,
"table_template"
Let firsttime = False
End If
'
' load the work table from the csv file
'
Let fn = "C:\KH\" & f1.Name
DoCmd.TransferText acImportDelim, "KH Import Specification",
"work_table", fn, True
'
' export the work table to the xls file using the copy of
the
query template
'
DoCmd.CopyObject , tn, acQuery, qt
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
tn,
wk,
True
DoCmd.DeleteObject acQuery, tn
'
' get the Min and Max check dates on the file
'
Let mindate = DMin("[check date]", "work_table")
Let maxdate = DMax("[check date]", "work_table")
' MsgBox maxdate
'
' open the xls file
'
Set xlbook = xl.Workbooks.Open(wk)
Set xlsheet = xl.ActiveSheet
'
' for debugging
'
' x = xlsheet.Name
' MsgBox x
' x = xlsheet.Name
' MsgBox x
'
' freeze row 1 for display
'
xlsheet.Activate
xlsheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'
' bold row 1
'
With xlsheet
For Each cell In xlsheet.Range("A1", "O1")
cell.Font.Bold = True
Next
End With
'
' autosize row 1
'
With xlsheet
.Columns("A:N").Font.Name = "Arial"
.Columns("A:N").Font.Size = 9
.Columns("A:N").EntireColumn.AutoFit
End With
'
' set headers and footers
'
With xlsheet.PageSetup
.PrintTitleRows = xlsheet.Rows(1).Address
.PrintTitleColumns = xlsheet.Columns("A:O").Address
.Orientation = xlLandscape
.FitToPagesTall = False
.FitToPagesWide = 1
' .CenterHeader = "Labor Distribution " & Chr(10) & "for"
&
Chr(10) & "&A"
.LeftHeader = "&B" & "Check Dates " & mindate & " to " &
maxdate
& "&B"
.CenterHeader = "&B" & "Labor Distribution for " & "&A" &
"&B"
.CenterFooter = "&F" & " " & "&D"
.RightFooter = "&R Page &P of &N"
.LeftMargin = xl.InchesToPoints(0)
.RightMargin = xl.InchesToPoints(0)
.TopMargin = xl.InchesToPoints(0.5)
.BottomMargin = xl.InchesToPoints(0.5)
.HeaderMargin = xl.InchesToPoints(0.25)
.FooterMargin = xl.InchesToPoints(0.25)
End With
'
' save and close workbook
'
xlbook.Save
xlbook.Close
Set xlsheet = Nothing
Set xlbook = Nothing
Let fm = "C:\KH\archived\" & f1.Name
' s = s & fn
' s = s & vbCrLf
fs.movefile fn, fm
DoCmd.OpenQuery "erase_work_table"
End If
Next
' MsgBox s
DoCmd.DeleteObject acTable, "work_table"
'
' cleanup
'
xl.Quit
Set xl = Nothing
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel not found " & Err.Number & " " &
Err.Description
Else
MsgBox "Excel found " & Err.Number & " " & Err.Description
xl.Quit
Set xl = Nothing
End If
Set f = Nothing
Set fc = Nothing
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Access to Excel Automation Runtime Error 3
Pass Variable from procedure to function 8
At my wits end...abt launching document once file is exported to excel. 5
Problem quitting Excel in Acess VBA code 2
Exort set of queries to excel 2
Error when adding sheets to Excel workbook from Access VBA 8
closing excel 1
Importing Excel Sheet Problem 1

Top