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

L

lookingforK

Registered User.
Local time
Today, 02:10
Joined
Aug 29, 2012
Messages
48
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.
 
N

Notedop

Registered User.
Local time
Today, 11:10
Joined
Jul 5, 2012
Messages
19
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?

Code: 
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
 
P

pwbrown

Registered User.
Local time
Today, 10:10
Joined
Oct 1, 2012
Messages
170
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.
 
N

Notedop

Registered User.
Local time
Today, 11:10
Joined
Jul 5, 2012
Messages
19
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.

Code: 
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
 
P

pwbrown

Registered User.
Local time
Today, 10:10
Joined
Oct 1, 2012
Messages
170
What's your objective? It depends on what you are trying to do.
 
P

pwbrown

Registered User.
Local time
Today, 10:10
Joined
Oct 1, 2012
Messages
170
Notedop said:
My objective is: help LookingForK :p
Click to expand...

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.
 
L

lookingforK

Registered User.
Local time
Today, 02:10
Joined
Aug 29, 2012
Messages
48
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



Notedop said:
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.

Code: 
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
Click to expand...
 
N

Notedop

Registered User.
Local time
Today, 11:10
Joined
Jul 5, 2012
Messages
19
You will also need to add the following function:

Code: 
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
 
L

lookingforK

Registered User.
Local time
Today, 02:10
Joined
Aug 29, 2012
Messages
48
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:

Code: 
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.
 
You must log in or register to reply here.

Similar threads

T
Solved Append table to excel file
Replies
8
Views
797
ebs17
E
M
Solved Converting txt file to xlsx
Replies
5
Views
371
miacino
M
W
Check for open excel workbook and if open take control
2
Replies
23
Views
968
ebs17
E
T
PDF to Excel using Acrobat/Adobe Library within Access
Replies
1
Views
416
ComputerVersteher
C
B
VBA problem relating to SQL linked table
Replies
6
Views
520
CJ_London
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom