How to use VBA to check whether an Excel .xlsx file is open and close it if it is ope

[lookingforK]

Hi,

I am using MS Access 2007 to export data to an MS Excel 2007 wookbook (.xlsx).

The code looks like:

......
Private Sub GenerateReport(ReportPath As String, Q4 As String)
Dim xl As New Excel.Application
Dim wkbDest As Excel.Workbook
Dim wkbSource As Excel.Workbook

(How to write the VBA code here: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue)

' Check whether the Excel exists in the folder. If it already exists, pop up a message for an option of replacing it or not
If Len(Dir(ReportPath & "\" & "the Excel .xlsx file name for taking data from Access")) > 0 Then
If MsgBox("[" & ReportPath & "\" & "the Excel .xlsx file name for taking data from Access" & "]" & " already exists." & _
Chr(13) & Chr(10) & Chr(13) & Chr(10) & " Replace it?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
Else
Kill ReportPath & "\" & "the Excel .xlsx file name for taking data from Access"
End If
End If

' Export data to the Excel wookbook
DoCmd.OutputTo acOutputQuery, ......
.....


How to write the VBA code for the part: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue?


Thank you in advance.

[June7]

The only way I know to close a file is to terminate all instances of the application which will close all files opened by the targeted application. I did a lot of research when I finally settled on this. If you find some way to close a specific file that has not been opened as an object in VBA, will be happy to see it.

I do this in a VBScript to make sure db is closed before trying to open it each morning:
Dim objWMIService, objProcess, colProcess
Dim strComputer, strProcessKill
strComputer = "."
strProcessKill = "'msaccess.exe'"
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & strProcessKill )
For Each objProcess in colProcess
objProcess.Terminate()
Next

[stmoong]

Take a look at this post from another forum: http://www.ozgrid.com/forum/showthread.php?t=16693

You might want to consider if you want to close the file or abort the operation if it is opened, in case another user is working on it.

[June7]

Code in that sample is intended to run inside Excel, not Access. But I tried it. It will close the Excel workbooks but unfortunately it leaves an Excel process running in Task Manager even after I manually close Excel application. This is not good.

[stmoong]

Ok, that is due to the orphaned instance of Excel that get instantiated when calling the Workbook. Will need to declare those objects in the code.

Modifying the code from the other forum, like so. The error handling code ensures that the Excel instances will be closed in the event of error, much like the try-catch-finally block in .Net and Java languages.

Code not tested though, so if there's error, gotta debug them. But that's the basic idea.

Sub CloseNamed()
    Const strWbkName As String = "ABook.xls" 
    Dim xlApp As Excel.Application
    Dim xlWkBk As Excel.Workbook

    On Error Goto ERR_HANDLER
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False   'Hide the application

    If IsWorkbookOpen(strWbkName) Then
        Set xlWkBk = xlApp.Workbooks(strWbkName)
        xlWkBk.Close savechanges:=False

    Else
        'Open it and read the file and do something with the data
        Set xlWkBk = xlApp.Workbooks.Open(FileName:=strWbkName, ReadOnly:=True)
    End If

EXIT_CLEANUP:
    'Cleanup code
    On Error Resume Next
    xlWkBk.Close False
    Set xlWkBk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Exit Sub

ERR_HANDLER:
    'Error handling code here...
    Resume EXIT_CLEANUP
End Sub 
 
Function IsWorkbookOpen(stName As String) As Boolean
    Dim xlApp As Excel.Application
    Dim xlWkBk As Excel.Workbook

    On Error Goto ERR_HANDLER
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False   'Hide the application

    Set xlWkBk = xlApp.Workbooks(stName) 
    If Not Wkb Is Nothing Then IsWorkbookOpen = True 
    'Boolean Function assumed To be False unless Set To True

EXIT_CLEANUP:
    'Cleanup code
    On Error Resume Next
    Set xlWkBk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Exit Function

ERR_HANDLER:
    'Error handling code here...
    IsWorkbookOpen = True
    Resume EXIT_CLEANUP
End Function

[June7]

The point to note is that all Excel workbooks associated with an instance of Excel will close when the app is Quit. And if there are multiple instances of Excel running for whatever reason, I think the code cannot distinguish them and will quit one but might not be the intended one. In my experiences of testing/debugging various code I have seen multiple instances of Excel in Task Manager when no workbooks were open. I would manually terminate each process then test revised code.

[lookingforK]

Thank you.

Based on the hints from an expert, after I modified the following code and embedded it (e.g. Functions) into the original [Event Procedure], it works ...

For example, loop through all workbooks that are open, if a specific workbook "Book1.xlsx" is found, it should be closed:

Public Function test1()
    Dim oApp As Object
    Dim workbook1 As Object
    
    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
    
Set oApp = GetApplication("excel.Application")
        For Each workbook1 In oApp.Workbooks
            If workbook1.FullName = "I:\Book1.xlsx" Then
                MsgBox "Find " & workbook1.FullName & " Gonna save and close it"
                workbook1.Save
                workbook1.Close
            End If
        Next workbook1
Set oApp = Nothing
End Function

Private Function GetApplication(ByVal AppClass As String) As Object
    Const vbErr_AppNotRun = 429
    On Error Resume Next
    Set GetApplication = GetObject(Class:=AppClass)
    If Err.Number = vbErr_AppNotRun _
        Then Set GetApplication = CreateObject(AppClass)
    On Error GoTo 0
End Function

Just a little problem here, if there is no wookbook opened, the MsgBox "No document!" can't display. Still testing this ...