VBA Question - Checking if file is open before opening it

[jphanton00]

I need VBA code to test if a file in a directory is open before opening it. If the file is open then I want a message box to pop up letting the user know its open. Once the user clicks OK, then I want it to skip the next set of steps and move on to attempting to open the next file. If the file is not open then I want it to proceed with the next set of steps.

I already have a macro written that I would like to insert this code into. I can't figure out how to attach the code I currently have (its rather lengthy) to give you an idea of where I need it and what comes next. But the just of what I'm already doing is consolidating new entries on multiple files into one file. The other day someone was in one of the files I was trying to consolidate and it hung up my macro. So I just want it to bypass attempting to open it and move on to the next one.

I've already spent about 4 hours reasearching this and trying different codes, but nothing is working.

Thanks in advance for your help!!

 

[VoG]

You can use this function

Function BookOpen(wbName As String) As Boolean
On Error Resume Next
BookOpen = Len(Workbooks(wbName).Name)
End Function

and call it like this

If BookOpen("test.xls") Then
    MsgBox "File is open"
Else
    'code to open file
End If

 

[njimack]

Take a look at the first function here: Spreadsheet Page Excel Tips: Some Useful VBA Functions

 

[jphanton00]

The problem with this code is that
"Function BookOpen(wbName As String) As Boolean", the "(wbName As String)", the wbName will change with each file I atempt to open. Also, the file is in a directory, so it needs to open the file from a path.
In my current macro I already have the path and each filename set As String. The following is part of macro I have already:

Sub Upload()</SPAN>
Dim UserInput As Variant</SPAN>
Dim wbFilename As String</SPAN>
Dim Count As Integer</SPAN>
Dim Forloop As Integer</SPAN>
Dim FirstRange As Range</SPAN>
Dim Foremost As String</SPAN>
Dim QA As String</SPAN>
Dim PremDisb As String</SPAN>
Dim FinReporting1 As String</SPAN>
Dim FinReporting2 As String</SPAN>
Dim PremRes As String</SPAN>
Dim PremAppControlandBal As String</SPAN>
Dim AgtCompensation As String</SPAN>
Dim Directory As String</SPAN>
Dim ForemostNum As Integer</SPAN>
Dim QANum As Integer</SPAN>
Dim Fin1Num As Integer</SPAN>
Dim Fin2Num As Integer</SPAN>
Dim PremDisbNum As Integer</SPAN>
Dim PremResNum As Integer</SPAN>
Dim PremAppControlandBalNum As Integer</SPAN>
Dim AgtCompensationNum As Integer</SPAN>

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN>
QA = "Quality Assurance WQA DB 2012.xlsm"</SPAN>
Foremost = "Foremost WQA DB 2012.xlsm"</SPAN>
PremDisb = "Premium Disbursements WQA DB 2012.xlsm"</SPAN>
PremRes = "Premium Resolution WQA DB 2012.xlsm"</SPAN>
PremAppControlandBal = "Premium Application Control and Balancing WQA DB 2012.xlsm"</SPAN>
FinReporting1 = "Financial Reporting 1 WQA DB 2012.xlsm"</SPAN>
FinReporting2 = "Financial Reporting 2 WQA DB 2012.xlsm"</SPAN>
AgtCompensation = "Agent Compensation Team WQA DB 2012.xlsm"</SPAN>
Directory = "\\pafnp0628\Accounting\00000 Management Reports\QA Reviews\2012\"</SPAN>
'''''''''''''''''''''''''''''''''''''''
Here is where I need it to see if the QA file is open (Directory & QA) If it is then the message box and on the next file.
Workbooks.Open Directory & QA</SPAN></SPAN>
Workbooks(QA).Activate</SPAN>
Sheets("Database").Select</SPAN>
Application.Run ("DisplayAllQuestions")</SPAN>
Application.Run ("Unprotect")</SPAN>
Application.Run ("UnhideColumns")</SPAN>
Range("A46:Ab46").Select</SPAN>
Range("ab46").Activate</SPAN>
Selection.AutoFilter</SPAN>
Selection.AutoFilter</SPAN>
Selection.AutoFilter Field:=23, Criteria1:="1"</SPAN>
Selection.AutoFilter Field:=28, Criteria1:="="</SPAN>
Range("a47:AA47").Select</SPAN>
Range(Selection, Selection.End(xlDown)).Select</SPAN>
Selection.Copy</SPAN>
Workbooks("WQA Upload.xlsm").Activate</SPAN>
Range("A25").Select</SPAN>
If ActiveCell = "" Then</SPAN>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _</SPAN>
:=False, Transpose:=False</SPAN>
Else</SPAN>
Selection.End(xlDown).Select</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _</SPAN>
:=False, Transpose:=False</SPAN>
End If</SPAN>
Workbooks(QA).Activate</SPAN>
Selection.AutoFilter Field:=23</SPAN>
Selection.AutoFilter Field:=28</SPAN>
Range("AB47").Select</SPAN>
ActiveCell.End(xlDown).Select</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Do While ActiveCell.Value <> ""</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Loop</SPAN>
Do Until IsEmpty(ActiveCell.Offset(0, -5))</SPAN>
If ActiveCell.Offset(0, -5) = "1" And ActiveCell = "" Then</SPAN>
ActiveCell.Formula = "=""Uploaded on ""&TEXT(TODAY(),""MM/DD/YY"")"</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
ElseIf ActiveCell.Offset(0, -5) = "0" Then</SPAN>
ActiveCell = ""</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Else</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
End If</SPAN>
Loop</SPAN>
Application.Run ("RehideColumns")</SPAN>
Range("A47").Select</SPAN>
Workbooks(QA).Save</SPAN>
Workbooks(QA).Close</SPAN>
Workbooks("WQA Upload.xlsm").Activate</SPAN>
Workbooks("WQA Upload.xlsm").Save</SPAN>
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN>
This is the next file to test (Directory & Foremost) If it is then the message box and on the next file.
Workbooks.Open Directory & Foremost</SPAN></SPAN>
Workbooks(Foremost).Activate</SPAN>
Sheets("Database").Select</SPAN>
Application.Run ("DisplayAllQuestions")</SPAN>
Application.Run ("Unprotect")</SPAN>
Application.Run ("UnhideColumns")</SPAN>
Range("A31:Ab31").Select</SPAN>
Range("ab31").Activate</SPAN>
Selection.AutoFilter</SPAN>
Selection.AutoFilter</SPAN>
Selection.AutoFilter Field:=23, Criteria1:="1"</SPAN>
Selection.AutoFilter Field:=28, Criteria1:="="</SPAN>
Range("a32:AA32").Select</SPAN>
Range(Selection, Selection.End(xlDown)).Select</SPAN>
Selection.Copy</SPAN>
Workbooks("WQA Upload.xlsm").Activate</SPAN>
Range("A25").Select</SPAN>
If ActiveCell = "" Then</SPAN>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _</SPAN>
:=False, Transpose:=False</SPAN>
Else</SPAN>
Selection.End(xlDown).Select</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _</SPAN>
:=False, Transpose:=False</SPAN>
End If</SPAN>
Workbooks(Foremost).Activate</SPAN>
Selection.AutoFilter Field:=23</SPAN>
Selection.AutoFilter Field:=28</SPAN>
Range("AB32").Select</SPAN>
ActiveCell.End(xlDown).Select</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Do While ActiveCell.Value <> ""</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Loop</SPAN>
Do Until IsEmpty(ActiveCell.Offset(0, -5))</SPAN>
If ActiveCell.Offset(0, -5) = "1" And ActiveCell = "" Then</SPAN>
ActiveCell.Formula = "=""Uploaded on ""&TEXT(TODAY(),""MM/DD/YY"")"</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
ElseIf ActiveCell.Offset(0, -5) = "0" Then</SPAN>
ActiveCell = ""</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
Else</SPAN>
ActiveCell.Offset(1, 0).Select</SPAN>
End If</SPAN>
Loop</SPAN>
Application.Run ("RehideColumns")</SPAN>
Range("A32").Select</SPAN>
Workbooks(Foremost).Save</SPAN>
Workbooks(Foremost).Close</SPAN>
Workbooks("WQA Upload.xlsm").Activate</SPAN>
Workbooks("WQA Upload.xlsm").Save</SPAN>
''''''''''''''''''''''''''''''''''''</SPAN>
There's more to this macro, but there's like 7 files I open and its pages long. So above it the jist of the code.

 

[VoG]

Try like this

If BookOpen(QA) Then
    MsgBox QA & " already open"
Else
    Workbooks.Open Directory & QA
End If

 

[JLGWhiz]

Here is a primitive method of checking.

Code:
Sub ChkWBstat()
On Error GoTo HDLR:
Workbooks("Test1.xlsx").Activate
CONT:
On Error GoTo 0
'Additional code if needed
HDLR:
If Err.Number = 9 Then
MsgBox "Workbook Not Found"
Err.Clear
GoTo CONT:
End If
End Sub
Code:

 

[jphanton00]

I'm clear on the If Then Else VBA, but not so much on the function piece. Where is the function making the File Name a variable to change depending on which file I'm checking? And I'm not seeing in the function the part about looking in the path for the file name.

 

[VoG]

The path does not matter in regard to checking whether a file is open. For example you can only have one test.xls open irrespective of which path it was opened from.

 

[jphanton00]

Sorry, I didn't make that part clear...I'm not checking to see if I have the file open as I would already know that answer. I'm checking to see if another user has the file open, like another person within my department. I went to run this macro the other day and a coworker was in the file, so it hung up my macro. So to avoid this issue I want to add steps to check to see if its open by someone else prior to attempting to open it.

 

[VoG]

The following will open a file only if it not open in write mode by someone else.

Function OpenFile(fName As String) As Boolean
On Error GoTo NotOpen
Set wb = Workbooks.Open(Filename:=fName, notify:=False)
On Error GoTo 0
OpenFile = True
Exit Function
NotOpen:
End Function