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

[lookingforK]

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

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? :banghead:


Thank you in advance.

 

[pwbrown]

This might help: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/IsWorkbookOpen.htm

 

[Notedop]

Hi,

I was thinking to check all workbooks that are open, then check if it is the correct one and then close it.
I got the following however it will not loop through all workbooks, only one.
Anyone an idea how to solve that?

Public Function test()
    Dim oApp As Object
    Dim intCount
    Dim workbook1 As Object
    
    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
    With oApp
        For Each workbook1 In oApp.Workbooks
             MsgBox workbook1.FullName
        Next workbook1
    End With
    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

 

[pwbrown]

Where are you closing the workbooks?
I'm probably wrong but I thought you can only check the active workbook, if you have more than one, you close the active workbook and check again.

 

[Notedop]

well, I wasn't closing yet. First wanted to check if I was able to loop through all open excel files.
If your statement is true, then everything will be closed anyhow.

Not the prettiest code, but works closing all open files. Leave out the msgbox if you want it to be done silently. Saves before closing.

Public Function test()
    Dim oApp As Object
    Dim intCount
    Dim workbook1 As Object
    
    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
    
GoTo check
check:
Set oApp = GetApplication("excel.Application")
        For Each workbook1 In oApp.Workbooks
             MsgBox workbook1.FullName
            workbook1.Save
            workbook1.Close
            GoTo check
        Next workbook1
oApp.Quit
Set oApp = Nothing
End Function

 

[pwbrown]

What's your objective? It depends on what you are trying to do.

 

[Notedop]

My objective is: help LookingForK

 

[pwbrown]

My objective is: help LookingForK

Oh, I thought you needed help too, was going to describe how I would solve your problem myself.

LookingforK there should be enough here to accomplish what you want, need further help just ask here.

 

[lookingforK]

This might help: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/IsWorkbookOpen.htm

Thank you pwbrown,

It looks like the VBA code provided by the link is for Excel.

Do you have the VBA code I can use with MS Access 2007?

 

[lookingforK]

Thank you Notedop,

I got some error messages when calling the function you provide to me.

For example, for GetApplication, I got:
Compile error: Sub or Function not defined

well, I wasn't closing yet. First wanted to check if I was able to loop through all open excel files.
If your statement is true, then everything will be closed anyhow.

Not the prettiest code, but works closing all open files. Leave out the msgbox if you want it to be done silently. Saves before closing.

Public Function test()
    Dim oApp As Object
    Dim intCount
    Dim workbook1 As Object
 
    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
 
GoTo check
check:
Set oApp = GetApplication("excel.Application")
        For Each workbook1 In oApp.Workbooks
             MsgBox workbook1.FullName
            workbook1.Save
            workbook1.Close
            GoTo check
        Next workbook1
oApp.Quit
Set oApp = Nothing
End Function

 

[Notedop]

You will also need to add the following 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
 
 
'and the test function which saves and closes all open workbooks.
 
Public Function test()
    Dim oApp As Object
    Dim intCount
    Dim workbook1 As Object
    
    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
    
GoTo check
check:
Set oApp = GetApplication("excel.Application")
        For Each workbook1 In oApp.Workbooks
             MsgBox workbook1.FullName
            workbook1.Save
            workbook1.Close
            GoTo check
        Next workbook1
oApp.Quit
Set oApp = Nothing
End Function

 

[lookingforK]

Thank you Notedop.

Based on your code, the problem is solved.

For example, if a specific Excel file "Book1.xlsx" is found, it should be closed:

Public Function test1()
    Dim oApp As Object
'    Dim intCount
    Dim workbook1 As Object
    
[COLOR=red]    Set oApp = GetApplication("excel.Application")
    If oApp Is Nothing Then
        MsgBox "No document!"
        Exit Function
    End If
[/COLOR]    
GoTo check
check:
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
' oApp.Quit
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

This part can't work even if there is no Excel file opened ...
Set oApp = GetApplication("excel.Application")
If oApp Is Nothing Then
MsgBox "No document!"
Exit Function
End If

Whatever, thank you.