Testing for a open worksheet from Outlook

[Phillips]

Iam trying to see if a worksheet is open.
I have the following code, but it ONLY returns the correct response if it is
called from the same instance of excel as the file is opened.

How can I test for an open file in ANY and ALL instances of excel?

Thanks
Phil

Sub B()
Dim mFilename As String
Dim IsFile As Boolean
Dim FixedName As String
Dim IsOpen As Boolean

mFilename = "c:\current.xls"
IsFile = FileExists("c:\current.xls")
If IsFile Then 'see if file is open
'get filename only
FixedName = FileNameOnly(mFilename)
MsgBox FixedName
IsOpen = WorkbookIsOpen(FixedName)
MsgBox IsOpen


Else
MsgBox "File: " & mFilename & " is not present..."
End If





End Sub





'Some Useful VBA Functions
'VBA has many useful built-in functions, but it lacks the ability to perform
many common tasks. For 'example, if your application needs to determine if a
particular file exists, you need to write 'your own code to make that
determination.

'This tip contains VBA code for six simple, but very useful functions. You
can simply copy the code 'and paste it to your module.

'FileExists - Returns TRUE if a particular file exists.
'FileNameOnly- Extracts the filename part of a path/filename string.
'PathExists - Returns TRUE if a particular path exists.
'RangeNameExists - Returns TRUE if a particular range name exists.
'SheetExists - Returns TRUE if a particular sheet exists.
'WorkBookIsOpen - Returns TRUE if a particular workbook is open.

'---------------------------------------------------------------------------
-----

'The FileExists Function
Private Function FileExists(fname) As Boolean
' Returns TRUE if the file exists
Dim x As String
x = Dir(fname)
If x <> "" Then FileExists = True _
Else FileExists = False
End Function

'---------------------------------------------------------------------------
-----

'The FileNameOnly Function
Private Function FileNameOnly(pname) As String
' Returns the filename from a path/filename string
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = "\" Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function

'---------------------------------------------------------------------------
-----

'The PathExists Function
Private Function PathExists(pname) As Boolean
' Returns TRUE if the path exists
Dim x As String
On Error Resume Next
x = GetAttr(pname) And 0
If Err = 0 Then PathExists = True _
Else PathExists = False
End Function

'---------------------------------------------------------------------------
-----

'The RangeNameExists Function

Private Function RangeNameExists(nname) As Boolean
' Returns TRUE if the range name exists
Dim n As Name
RangeNameExists = False
For Each n In ActiveWorkbook.Names
If UCase(n.Name) = UCase(nname) Then
RangeNameExists = True
Exit Function
End If
Next n
End Function

'---------------------------------------------------------------------------
-----

'The SheetExists Function

Private Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function

'---------------------------------------------------------------------------
-----

'The WorkbookIsOpen Function

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

 

[Patrick Molloy]

the following code may give you some help. The Test
procedure passes a file address ( path & name) to a
function that returns the workbook object. The function
assign the workbook if its open, else it opens the
workbook. The test proc simply closes the wb again, but
its just a test script...


Sub Test()
Dim wbTest As Workbook
Dim testname As String
testname = "C:\fxo.xls"
Set wbTest = FileOpen1(testname)
If wbTest Is Nothing Then
MsgBox "Not Found"
Else
wbTest.Close False
Set wbTest = Nothing
End If
End Sub
Function FileOpen1(sFileName As String) As Workbook
Dim SShortName As String
Dim pos As Long
pos = InStrRev(sFileName, "\")
SShortName = Mid(sFileName, pos + 1)
On Error Resume Next
Set FileOpen1 = Workbooks(SShortName)
If Err.Number <> 0 Then
Err.Clear
Set FileOpen1 = Workbooks.Open(sFileName)
If Err.Number <> 0 Then
MsgBox "Unable to open " _
& sFileName, , _
"ERROR opening Workbook"
Err.Clear
Else

End If
End If
End Function

Tip: The Scripting Runtime FileSystemObject can be used
to test if a file actually exists...as apart from whether
its open or not

With New Scripting.FileSystemObject
If .FileExists(sFileName) Then
Set wbNew = Workbooks.Open(sFileName)
End If
End With

The neat thing with this code is that we haven't actually
set a variable to the FileSystemObject, so VB cleans up
the memory on the End With statement. Nice and tidy.

Here's the function again...

Function FileOpen1(sFileName As String) As Workbook
Dim SShortName As String
Dim pos As Long
pos = InStrRev(sFileName, "\")
SShortName = Mid(sFileName, pos + 1)
On Error Resume Next
Set FileOpen1 = Workbooks(SShortName)
If Err.Number <> 0 Then
Err.Clear
With New Scripting.FileSystemObject
If .FileExists(sFileName) Then
Set FileOpen1 = Workbooks.Open(sFileName)
End If
End With
End If
End Function


Patrick Molloy
Microsoft Excel MVP