Add logic to see if excel file is already open

[allenjasonbrown@gmail.com]

I am using the following code to export data to a specific workbook. I add data to about 5 sheets (so I call this function 5 times). Is there a way to just and just leave the excel doc open? I thought I could just remove the 'close' at the end but when the code executes it opens another instance. I think I need to put a condition on the open???

THanks for the help!!


Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler
strPath = "C:.......\file.xlsx"
Set rst = CurrentDb.OpenRecordset(QueryName)
Set ApXL = CreateObject("Excel.Application")

Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True




Set xlWSh = xlWBk.Worksheets(strSheetName)

xlWSh.Activate
xlWSh.Range("A1").Select

For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst

xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select

ApXL.ActiveSheet.Visible = False

rst.Close
Set rst = Nothing
xlWBk.Save
xlWBk.Close

Exit Function

[ssanfu]

Here are three links to Access/Excel info that might help you:

http://www.cpearson.com/Excel/Topic.aspx (Chip Pearson)
http://fontstuff.com/excel/index.htm (Martin Green)
http://www.accessmvp.com/kdsnell/EXCEL_MainPage.htm (Ken Snell)

[allenjasonbrown@gmail.com]

Thanks and I will certainly review these. I was hoping that there might be someone who could look at the code that I posted becuase I have already tested it and everything else seems to be working. I would hate to have to start over with the code.

[ssanfu]

Off the top of my head, you are calling a function. Once the function ends the variables/declarations go out of scope.

You would have to move the parts of the code that open the spreadsheet and close the spreadsheet to a higher routine. Where does the function get called from?

It also depends on HOW you call the function. Do you select the data to add to a spreadsheet one at a time or do you select the data to fill 5 spreadsheets, looping through the code without stopping???

[allenjasonbrown@gmail.com]

Thanks. I am just exporting 5 different tables to 5 different worksheets (all in the same excel file) all at once. (One right after another). It is just being called from a previous sub where the only thing in it is:
Call ExportToSpecificSheet("table1", "sheet1")
Call ExportToSpecificSheet("table2", "sheet2")
Call ExportToSpecificSheet("table3", "sheet3")
Call ExportToSpecificSheet("table4, "sheet4")
Call ExportToSpecificSheet("table5", "sheet5")

Is there a better way to incorporate this into the code where i do nto have to open/close 5 times?

[ssanfu]

In your first post, you didn't include the function name so I guessed at it.

"Sub Button_Click()" would be how you start the export process. If you clicked a button, that is the code that would execute. Change "Button_Click" to your button (?) name.

I moved (or tried to ) the code that opens/closes Excel to the button click procedure.
The process would be:
- Open Excel
- Export all the data
- Close Excel


WARNING!! This is UNTESTED!!!

Sub Button_Click()

   Dim ApXL As Object
   Dim xlWBk As Object
   Dim xlWSh As Object
   Dim strPath As String

   ' EXCEL file that is to contain the exported data
   strPath = "C:.......\file.xlsx"
   Set ApXL = CreateObject("Excel.Application")
   Set xlWBk = ApXL.Workbooks.Open(strPath)
   ApXL.Visible = True

   'export data
   Call ExportToSpecificSheet("table1", "sheet1")
   Call ExportToSpecificSheet("table2", "sheet2")
   Call ExportToSpecificSheet("table3", "sheet3")
   Call ExportToSpecificSheet("table4", "sheet4")
   Call ExportToSpecificSheet("table5", "sheet5")


   ' now exit excel
   xlWBk.Save
   xlWBk.Close

End Sub

'I guessed at this line 
Function ExportToSpecificSheet(QueryName As String, strSheetName As String)

   Const xlCenter As Long = -4108
   Const xlBottom As Long = -4107

   Dim rst As DAO.Recordset
   Dim fld As DAO.Field

   On Error GoTo Err_Handler
   Set rst = CurrentDb.OpenRecordset(QueryName)

   Set xlWSh = xlWBk.Worksheets(strSheetName)

   xlWSh.Activate
   xlWSh.Range("A1").Select

   ' add field (column) names
   For Each fld In rst.Fields
      ApXL.ActiveCell = fld.Name
      ApXL.ActiveCell.Offset(0, 1).Select
   Next
   rst.MoveFirst

   'copy data to Excel
   xlWSh.Range("A2").CopyFromRecordset rst
   xlWSh.Range("1:1").Select

   ApXL.ActiveSheet.Visible = False

   rst.Close
   Set rst = Nothing

End Function