Procedure to Export Recordset to Excel Sheet - multiple instances?!?

[stephenmbell]

I have a procedure in my module that exports an adodb recordset to an excel spreadsheet.

The code I have below does work, however:

1. For some reason, if I create \\share\folder\myxls.xls and I look at open files on the network - i see two instances of myxls.xls being open

2. In addition, if I look at the task manager processes and see an entry for EXCEL.exe after the procedure has completed

I have done some research through other forums, and made some changes to my initial code, (using object reference vs application) but still experiencing these issues.

Why is this????
Thank you..
code posted below
you all rock

Public Sub OpenExcel(rst As ADODB.Recordset, Optional strReportTitle As String, Optional strDateRange As String)

On Error GoTo Err_OpenExcel

'declare local variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strOutput As String
Dim ret As Integer
Dim col As Excel.Range
Dim cCell As Excel.Range
Dim rwRow As Integer
Dim intCol As Integer
Dim strCol As String
Dim intStrPos As Integer
Dim cmdlgSaveFile As New clsCommonDialog

Const clngFilterIndexAll = 5
Const cTabTwo As Byte = 1

' set to break on all errors
Application.SetOption "Error Trapping", 0

'-------------------------------------------
'CODE FOR SAVE AS DIALOG
'-------------------------------------------

cmdlgSaveFile.Filter = "Microsoft Excel Files(*.xls)|*.xls|All Files (*.*)|*.*"

'cmdlgSaveFile.Filter = clngFilterIndexAll
'this is where the dialog opens
cmdlgSaveFile.ShowSave

'returns your full file name.
strOutput = cmdlgSaveFile.FileName

'hence no len, no name...
If Len(strOutput) = 0 Then
  DoCmd.Hourglass False
  Exit Sub
End If
'-------------------------------------------

' Create the Excel Applicaiton, Workbook and Worksheet
Set appExcel = New Excel.Application
Set wbk = appExcel.Workbooks.Add

ret = 1
ret = InStr(strOutput, ".xls")

'make sure filename ends in xls
If ret = 0 Then
  strOutput = strOutput & ".xls"
End If

wbk.SaveAs FileName:=strOutput
wbk.Close

Set wbk = appExcel.Workbooks.Open(strOutput)
Set wks = appExcel.Worksheets(cTabTwo)
'-------------------output report title------------------------

If strReportTitle <> "" Then
  Set rng = appExcel.Range("A1")
  rng.Select
  rng = strReportTitle
  rng.Font.Bold = True
End If

If strDateRange <> "" Then
  Set rng = appExcel.Range("A2")
  rng.Select
  rng = strDateRange
  rng.Font.Bold = True
End If

'export the data
Set rng = appExcel.Range("A4")
rng.CopyFromRecordset rst

'autofit the columns
Columns("B:J").EntireColumn.AutoFit

strCol = fnNumToAlpha(rst.Fields.Count)
Set rng = appExcel.Range("A1:" & strCol & rst.RecordCount + 2)
'rng.AutoFormat xlRangeAutoFormatList2

wbk.Save
wbk.Close
appExcel.Quit

Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing

Exit_OpenExcel:
    Exit Sub
Err_OpenExcel:
    MsgBox Err.Description
    Resume Exit_OpenExcel
    appExcel.Quit

End Sub

 

[PHV]

Replace this:
Columns("B:J").EntireColumn.AutoFit
with this:
appExcel.Columns("B:J").EntireColumn.AutoFit

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886