Macro in Excel to check if another workbook is opened.

[Catalin]

Hi to all and each one.

I'm looking to make a macro in VBA for the purposed posted below:

When I open the workbook "X", the macro should check if the workboo
"Y" is opened already. If not, either a message box should appear o
the workbook "Y" should be open.

Thanks in advance,
Catali

 

[Gary Keramidas]

maybe you could adapt something like this


Sub test()
On Error GoTo err
Workbooks("Y").Activate
GoTo cont:
err:
MsgBox "workbook Y not open"
Exit Sub
cont:
MsgBox "workbook y is open"
End Sub

 

[halimnurikhwan]

Hi Catalin Tri this:
in your Class module named Class1 :
Public WithEvents Appl As Application
Public bflag As Boolean
Private Sub Appl_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Name = "X.xls" Then
For r = 1 To Windows.Count
If InStr(1, Windows(r).Caption, "Y.xls") > 0 Then
bflag = True
Exit For
Else: bflag = False
End If
Next r
End If
If bflag Then
MsgBox "Workbook Y.xls is currently opened !"
Else
MsgBox "You should open Workbook Y.xls first !"
End If
End Sub

In your standard module :

Dim Apl As New Class1

Sub OpenFileX()
Set Apl.Appl = Application
filetoopen = Application.GetOpenFilename("Text Files (*.xls),
*.xls")
If filetoopen <> False Then
Workbooks.Open filetoopen
If InStr(1, filetoopen, "X.xls") <> 0 Then
If Apl.bflag = False Then ActiveWorkbook.Close False
End If
End If
Apl.bflag = False
Debug.Print InStr(1, filetoopen, "X.xls")
End Sub

Then Call openxfile procedure...
Note that the Workbook name is case sensitives

Thanks,,
halim



Gary Keramidas menuliskan:

 

[halimnurikhwan]

Hi Catalin,

after I try myself please change procedure of Class1 to :
Public WithEvents Appl As Application
Public bflag As Boolean
Private Sub Appl_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Name = "X.xls" Then
For r = 1 To Windows.Count
If InStr(1, Windows(r).Caption, "Y.xls") > 0 Then
bflag = True
Exit For
Else: bflag = False
End If
Next r
If bflag Then
MsgBox "Workbook Y.xls is currently opened !"
Else
MsgBox "You should open Workbook Y.xls first !"
End If
End If
End Sub

(e-mail address removed) menuliskan: