How to check if file is open

[xodus8]

I tried googling this and looking at forums couldn't really find an answer. I am writing a macro. The macro starts with opening an excel file, what I want it to do is to first check if the file is open if it is continue with the macro, if it isn't to open the file. I will post the beginning of my macro below. Thanks

Sub SpreadReportRun()

Application.ScreenUpdating = False
this_file = ActiveWorkbook.Name
target_path = Sheets("Control").Range("target_path")
target_file = Sheets("Control").Range("target_file")
Workbooks.Open FileName:=target_path & target_file, UpdateLinks:=0

Windows(this_file).Activate

[Benzadeus]

See http://www.vbaexpress.com/kb/getarticle.php?kb_id=468

[xodus8]

I tried that it does work but my macro looks a little complex, my coworker said the the if and else statement should only apply to the checking of the work book. This is what I got, how would I make it as simple as possible?

Sub Run()

Application.ScreenUpdating = False
this_file = ActiveWorkbook.Name
target_path = Sheets("Control").Range("target_path")
target_file = Sheets("Control").Range("target_file")


If IsFileOpen(target_path & target_file) Then

Windows(this_file).Activate

Calculate

Windows(this_file).Activate


i = 0

Do While Not (IsEmpty(Sheets("Control").Range("Run").Offset(i, 0)))
If (Sheets("Control").Range("Run").Offset(i, -2) = "x") Then

Sheets("Control").Select
Range("Run").Offset(i, 0).Select
Selection.Copy

Windows(target_file).Activate
Sheets("Parameters").Select
Sheets("Parameters").Range("B19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.CutCopyMode = False
Windows(target_file).Activate
Application.Run "SpreadRpt_EEV2008.xls!Import_Only"

Windows(target_file).Activate

Application.Run "SpreadRpt_EEV2008.xls!Calc_All"

Windows(this_file).Activate
Calculate
Sheets("PVFP").Select
Sheets("PVFP").Range("B10:B120").Select
Selection.Copy

Sheets("PVFP").Range("Paste_Value").Offset(0, i + 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Control").Select
End If
i = i + 1
Loop

Else

Workbooks.Open target_path & target_file, UpdateLinks:=0

Windows(this_file).Activate

Calculate

Windows(this_file).Activate


i = 0

Do While Not (IsEmpty(Sheets("Control").Range("Run").Offset(i, 0)))
If (Sheets("Control").Range("Run").Offset(i, -2) = "x") Then

Sheets("Control").Select
Range("Run").Offset(i, 0).Select
Selection.Copy

Windows(target_file).Activate
Sheets("Parameters").Select
Sheets("Parameters").Range("B19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.CutCopyMode = False
Windows(target_file).Activate
Application.Run "SpreadRpt_EEV2008.xls!Import_Only"

Windows(target_file).Activate

Application.Run "SpreadRpt_EEV2008.xls!Calc_All"

Windows(this_file).Activate
Calculate
Sheets("PVFP").Select
Sheets("PVFP").Range("B10:B120").Select
Selection.Copy

Sheets("PVFP").Range("Paste_Value").Offset(0, i + 1).Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Control").Select
End If
i = i + 1
Loop

End If

Application.ScreenUpdating = True

End Sub

Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer

On Error Resume Next
filenum = FreeFile()

Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0


Select Case errnum



Case 0
IsFileOpen = False


Case 70
IsFileOpen = True


Case Else
Error errnum
End Select

End Function

[Benzadeus]

This works:
If IsFileOpen(target_path & target_file) Then
'actions to perform in case file is opened
Else
'actions to perform in case file is not opened
End If

Your code is complex and I can't figure out what is going on without your workbook. Could you send it?

[p45cal]

I've tried reducing your code; I've used a simpler function to check for another excel workbook being open, I've taken out a lot of selecting, I think some more activating could be taken out. Unfortunately I haven't been able to test it at all. Sub Run2()
Application.ScreenUpdating = False
target_path = ThisWorkbook.Sheets("Control").Range("target_path")
target_file = ThisWorkbook.Sheets("Control").Range("target_file")

If WorkbookIsOpen(target_file) Then
Set TargetWb = Workbooks(target_file)
Else
Set TargetWb = Workbooks.Open(target_path & target_file, UpdateLinks:=0)
End If

Calculate
ThisWorkbook.Activate
i = 0
Do While Not (IsEmpty(ThisWorkbook.Sheets("Control").Range("Run").Offset(i, 0)))
If (ThisWorkbook.Sheets("Control").Range("Run").Offset(i, -2) = "x") Then
TargetWb.Sheets("Parameters").Range("B19") = ThisWorkbook.Range("Run").Offset(i, 0).Value
TargetWb.Activate
Application.Run "SpreadRpt_EEV2008.xls!Import_Only"
TargetWb.Activate
Application.Run "SpreadRpt_EEV2008.xls!Calc_All"
ThisWorkbook.Activate
Calculate
ThisWorkbook.Sheets("PVFP").Range("B10:B120").Copy
Sheets("PVFP").Range("Paste_Value").Offset(0, i + _
1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Control").Select
End If
i = i + 1
Loop
End If
Application.ScreenUpdating = True
End Sub

Private Function WorkbookIsOpen(wbname) As Boolean'courtesy John Walkenbach
'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

[xodus8]

p45 I used your function, it looks like it works, thanks so much.