L
Launchnet
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
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