Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Check if excel workbook is open! 1

Status
Not open for further replies.

HAGER

Technical User
Jul 30, 2004
4
US
I am working in an excel workbook and have written code in VBA to open another excel workbook and do some task. Pretty easy to open the file. See below.

Workbooks.Open Filename:= _
"c:\ABC.xls"

The problem I am having is that the next time I run my routine VBA wants to open the "ABC" file which is already open.

Questions: Is there code to check if the excel file is already open before trying to open a new file and if it is open to make it the active workbook?


Any support would be great. This is my first VBA project!
 
Try this

dim wbk as Workbook

for each wbk in application.workbooks
if wbk.fullname = "c:\abc.xls" then
wbk.activate
exit for
end if
next wbk
 
HAGER,
The usual way is to try to do something with the workbook and look for an error condition. Here is some code posted by John Walkenbach at
Code:
Private Function WorkbookIsOpen(wbname) As Boolean
'   Returns TRUE if the workbook is open
    Dim x As Workbook
    On Error Resume Next
    Set x = Workbooks(wbname)
    If Err = 0 Then WorkbookIsOpen = True _
        Else WorkbookIsOpen = False
End Function
Brad
 
THANKS, GoodOmens and Brad for responding.
Brad I used the function that you listed. Below is what I used to check if an excel file is open and close inactive workbooks. I tried to make it generic in case someone else could use it.

***********************************************************
Sub ISWORKBOOKOPEN()

'Set error trap
On Error GoTo Mainerror
Dim shortcut As String

'I created a shortcut because my workbook name may change
'This allows me to change it one time instead of several throughout script

shortcut = ("wbname")

'Call function to test if file is open.

If Not WorkbookIsOpen(shortcut) Then
'If the function returns False,
'make the workbook containing this script active
'and close other workbooks.
'Then open the document.

ThisWorkbook.Activate
Application.Run "CloseAllInactive"

'open document
'This differs from shortcut because it needs to
'be the complete path to access the file

Workbooks.Open Filename:="fname"

'Make workbook active and maximize it
Windows(shortcut).Activate
ActiveWindow.WindowState = xlMaximized


Else
'If funciton returns True, then the file is
'already open
'and the following should be completed

'Make document active and maximize it
Windows(shortcut).Activate
ActiveWindow.WindowState = xlMaximized

'Close all inactive workbooks with the exception of
'this workbook
Application.Run "CloseAllInactive"


End If
Exit Sub

Mainerror:
MsgBox "No Data within Selection", vbOKOnly

Exit Sub

End Sub


Function WorkbookIsOpen(shortcut) As Boolean
On Error Resume Next
Dim x As Workbook
'returns true if the book is open
Set x = Workbooks(shortcut)

If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False

End Function

Public Sub CloseAllInactive()
'This script will close all inactive windows
'Except for the workbook that is running this script

Dim Wb As Workbook
Dim AWb As String
Dim ThisWb As String
AWb = ActiveWorkbook.Name
ThisWb = ThisWorkbook.Name

'SaveAll could be added here if you want to save before
'closing. The current setup will close without saving.
'In my application I don't want users saving to workbooks.

For Each Wb In Workbooks
If Wb.Name <> AWb Then
If Wb.Name <> ThisWb Then
Wb.Close Savechanges:=False
End If
End If
Next Wb

End Sub
***********************************************************
Thanks should also be given to John Walkenbach and CPearson.

Tracey

 
I'm having this same problem but I'm getting lost in this code.

What I need is for it to just check if a file is open, if it isn't, it opens it, if it is, it doesn't do anything, and goes on to the next code.

I've been working with it but I can't seem to get it going.

Thanks in advance
 
monagan,
Try using Walkenbach's function like this:
Code:
Sub OpenMe()
Dim flPath As String, flName As String
flPath = "C:\VBA\"      'The path must end in a backslash
flName = "Book1.xls"
    'If workbook is not open, then open it
If Not WorkbookIsOpen(flName) Then Workbooks.Open (flPath & flName)
End Sub

Private Function WorkbookIsOpen(wbname) As Boolean
'   Returns TRUE if the workbook is open
    Dim x As Workbook
    On Error Resume Next
    Set x = Workbooks(wbname)
    If Err = 0 Then WorkbookIsOpen = True _
        Else WorkbookIsOpen = False
End Function
If you run the OpenMe sub, it will test if Book1.xls is open. If not, it will go to the path specified and open that workbook.
Brad
 
I'm trying things using the code you gave me. But it ends up messing up my other code.

I cannot seem to find a way to incorporate my code into yours.

This is what opens it now..

OpenSheet = Sheets("sheet1").Cells(17, 4).Value
Set wbTS = Workbooks.Open("C:\Documents and Settings\Jon Monagan\My Documents\Gary\TIME SHEETS.xls")
wbTS.Sheets(OpenSheet).Select
lRow = wbTS.Sheets(OpenSheet).Columns(1).Cells.Find(ENAME, LookIn:=xlValues).Row
iCol = wbTS.Sheets(OpenSheet).Rows(1).Cells.Find(EDATE, LookIn:=xlValues).Column
wbTS.Sheets(OpenSheet).Cells(lRow, iCol).Select
ActiveCell.Value = EHOURS


And I need that to run if it isn't open, which works fine. Now if it is open, I just need it to switch to that worksheet.
 
Jon,
Try the following modification to your code:
Code:
Sub GetEDATE()
Dim OpenSheet As String, ENAME As String, flName As String, flPath As String
Dim wbTS As Workbook
Dim lRow As Long, iCol As Long
Dim EHOURS As Variant
Dim EDATE As Date

flPath = "C:\Documents and Settings\Jon Monagan\My Documents\Gary\"
flName = "TIME SHEETS.xls"
OpenSheet = Sheets("sheet1").Cells(17, 4).Value
If Not WorkbookIsOpen(flName) Then Workbooks.Open (flPath & flName)
Set wbTS = Workbooks(flName)
wbTS.Activate
wbTS.Sheets(OpenSheet).Activate
lRow = wbTS.Sheets(OpenSheet).Columns(1).Cells.Find(ENAME, LookIn:=xlValues).Row
iCol = wbTS.Sheets(OpenSheet).Rows(1).Cells.Find(EDATE, LookIn:=xlValues).Column
wbTS.Sheets(OpenSheet).Cells(lRow, iCol) = EHOURS

End Sub
Note that you will need to add values for EDATE, EHOURS, ENAME--and possibly also change their Dim statements to a more appropriate variable type.
Brad
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top