Thread: Fileopen Logic

Hi,

I've this piece of code written to always open the file in read-write mode (a shared file being used by multiple users at a time - Being used as a database).

Could you please check.. improve the logic or the code or suggest better or simple methods? Thanks a ton

"FolderName" contains the path to the file
"WorkBookName" contains the actual file name

Code:

TRYAGAIN:
    If FileAlreadyOpen(WorkBookName) Then
CLOSEAGAIN:
        On Error GoTo CLOSEAGAIN
        Workbooks(WorkBookName).Close False
OPENAGAIN:
        On Error GoTo OPENAGAIN
        Workbooks.Open FolderName + WorkBookName, , False
        Else
            If FileAlreadyOpen2(FolderName + WorkBookName) Then
                GoTo TRYAGAIN
                Else
	      On Error GoTo TRYAGAIN
                    Workbooks.Open FolderName + WorkBookName, , False
            End If
    End If
    Workbooks(WorkBookName).Activate
    On Error Resume Next

Code:

Function FileAlreadyOpen(WorkBookName As String) As Boolean
    FileAlreadyOpen = False
    On Error GoTo NOFILE
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then FileAlreadyOpen = True
NOFILE:
End Function

Code:

Function FileAlreadyOpen2(FullFileName As String) As Boolean
Dim f As Integer
    f = FreeFile
    On Error Resume Next
    Open FullFileName For Binary Access Read Write As #f
    Close #f
    If Err.Number <> 0 Then
        FileAlreadyOpen2 = True
        Err.Clear
        Else: FileAlreadyOpen2 = False
    End If
    On Error GoTo 0
End Function

Thanks a lot again...

You could shrink your code by using the below function and macro, This will not loop but you can adpate so it will loop.

Excel does automatically tell you if the file is already open by other user when working on a network.

I hope this helps you

Function

Code:

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

Macro:

Code:

Dim FolderName as String
Dim WorkBookName as String
TryOpen:
If Not IsFileOpen(WorkBookName) Then
' Open the File
       Workbooks.Open FolderName + WorkBookName, , False
Else
       msg = "This file is currently open by another user"
       Title = "Error"
       Style = vbOk
       Response = MsgBox(msg, Style, Title)
       If Response = vbOKOnly Then
           GoTo EndIt
       End If  
End If
EndIt: