B
Ben
I've got a DB that exports to Excel by opening an instance of excel,
then record-by-record it dumps the fields into the cells of a workbook
that has been copied from a workbook used as a template. It then opens
the excel file.
When I close the excel file using the file's close button (within the
excel application) all is good.
Problem: When I close the excel file application itself, before
closing the excel file, an instance of excel remains running.
I have what I thought were all the necessary "=nothing" statements.
Also, when it automatically opens the new excel file, it opens with
the web toolbar visible as well (not my default)
Here's my code:
'note: the iCol and iRow have been mixed up in order to get the data
to list in columns instead of rows
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Const cTabOne As Byte = 1
Const cStartRow As Byte = 6
Const cStartColumn As Byte = 1
DoCmd.Hourglass True
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
If side = "Dside" Then
sTemplate = CurrentProject.Path &
"\DsideResultsMatrixTemplate.xls"
sOutput = CurrentProject.Path & "\DsideResultsMatrix.xls"
ElseIf side = "Pside" Then
sTemplate = CurrentProject.Path &
"\PsideResultsMatrixTemplate.xls"
sOutput = CurrentProject.Path & "\PsideResultsMatrix.xls"
End If
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database
object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
sSQL = "select * from SearchQuery"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst
iCol = cStartColumn
iRow = cStartRow
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iCol, iRow) = rst.Fields(iFld)
If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iCol, iRow).NumberFormat = "m/d/yyyy"
End If
wks.Cells(iCol, iRow).WrapText = True
iFld = iFld + 1
Next
wks.Rows(iCol).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
err_Handler:
ExportRequest = Err.Description
Me.lblMsg.Caption = Err.Description
Resume exit_Here
then record-by-record it dumps the fields into the cells of a workbook
that has been copied from a workbook used as a template. It then opens
the excel file.
When I close the excel file using the file's close button (within the
excel application) all is good.
Problem: When I close the excel file application itself, before
closing the excel file, an instance of excel remains running.
I have what I thought were all the necessary "=nothing" statements.
Also, when it automatically opens the new excel file, it opens with
the web toolbar visible as well (not my default)
Here's my code:
'note: the iCol and iRow have been mixed up in order to get the data
to list in columns instead of rows
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Const cTabOne As Byte = 1
Const cStartRow As Byte = 6
Const cStartColumn As Byte = 1
DoCmd.Hourglass True
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
If side = "Dside" Then
sTemplate = CurrentProject.Path &
"\DsideResultsMatrixTemplate.xls"
sOutput = CurrentProject.Path & "\DsideResultsMatrix.xls"
ElseIf side = "Pside" Then
sTemplate = CurrentProject.Path &
"\PsideResultsMatrixTemplate.xls"
sOutput = CurrentProject.Path & "\PsideResultsMatrix.xls"
End If
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database
object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
sSQL = "select * from SearchQuery"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst
iCol = cStartColumn
iRow = cStartRow
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iCol, iRow) = rst.Fields(iFld)
If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iCol, iRow).NumberFormat = "m/d/yyyy"
End If
wks.Cells(iCol, iRow).WrapText = True
iFld = iFld + 1
Next
wks.Rows(iCol).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
err_Handler:
ExportRequest = Err.Description
Me.lblMsg.Caption = Err.Description
Resume exit_Here