Stopping a Macro from opening an Excel File More than 1 time.
 

High Everybody . . . I have a problem.

Mr. Bob Phillips was very kind to write a Macro for me that works perfectly,
testing if the (Path & File Name), in the active cell exists, also that if it
is already open, it will not be opened again. Well, I need the same Macro,
but I need the (Path and File name) to be hard coded into the macro. I have
tried, but I'm sorry to say that I'm just not good enough to do it. CAN
SOMEONE HELP ME PLEASE.

IN THE FOLLOWING EXAMPLE MACRO, I AM SHOWING THE CODE MODIFIED TO WHAT I
THINK IT SHOULD BE. If someone needs the full original code, using the Path
& File Name, located in an activecell, I will be happy to supply it.

THANKS IN ADVANCE. I THINK MY PROJECT IS ABOUT DONE WITH THIS MACRO.


'THIS MACRO CHECKS TO SEE IF FILE IS AVAILABLE AND TO SEE IF THE FILE IS
ALREADY OPEN. IF THE FILE EXISTS, THE MACRO PROCEEDS. IF THE FILE IS
ALREADY OPEN IT GIVES A MESSAGE THAT IT IS ALREADY OPEN.

Sub NewExcelWithWorkbook()
Dim oXL As Object 'This is needed to open a new instance of Excel.
'Without it, the file is only opened as a new Window

Dim testFileFind
Dim oWB As Object

'The following tests for the existance of the file
testFileFind = Dir("c:\extrafiles\personal.xls")

'If the file is not found there will be nothing in the variable and
processing ends.
If Len(testFileFind) = 0 Then
MsgBox "File Name 'personal.xls' is not is in extrafiles folder"
End
End If

'Check if the file is already open, do nothing if so
If Not IsFileOpen("personal.xls") Then

'THIS LINE OF CODE OPENS THE NEW INSTANCE OF EXCEL.
Set oXL = CreateObject("Excel.Application")

'THIS LINE OF CODE MAKES THE NEW INSTANCE OF EXCEL VISIBLE.
oXL.Visible = True

Set oWB = oXL.Workbooks.Open("c:\extrafiles\personal.xls")
Else

MsgBox "File 'personal.xls' is already open"
End If

End Sub

Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function

--
Please take a look at www.openoursite.com Click on: "Keywords" and then
Click on "Matt's Story" and if you are a man, you should be very happy that
you read my story. God Bless for everyones help.

Message posted via http://www.officekb.com