If workbook is in use by another user...

[ClimoC]

Hey guys

I need something to check if a file is in use, and if it is, abort the procedure, else proceed with update macro. (Company is on a citrix environment)

I've found one code on another site that looks like it would do this, but it's a Function, and I've never used one of those before so don't know where to put it in my subroutine.

My code for opening a workbook... (uses an Open File dialog)

Sub submitprog()
Dim filep As String, master As Workbook, ssheet As Worksheet, rr As Long
Set ssheet = ActiveSheet
Dim dlgOpen As FileDialog
    Dim name As String, fileName As String, Target As String
    Dim lngIndex As Long
     
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
    With dlgOpen
        .AllowMultiSelect = False
        .Show
        For lngIndex = 1 To .SelectedItems.Count
            filep = .SelectedItems(lngIndex)
        Next
    End With
On Error Resume Next: Err.Clear: Dim wb As Workbook, wb2 As Workbook
    Set wb2 = ThisWorkbook
    Set wb = Workbooks(filep)
    If Err.Number > 0 Then Set wb = Workbooks.Open(fileName:=filep, Local:=True)
    If Not wb Is Nothing Then wb.Worksheets(Sheet1).Activate Else MsgBox "File not found", vbInformation
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
'and so on do the rest of the macro
end sub

Could I slip something easily into the error-case for the open command above, or do I have to find a way to insert the following (and if so, how and where would I do it?)

Function FileAlreadyOpen(FullFileName As String) As Boolean
' returns True if FullFileName is currently in use by another process
' example: If FileAlreadyOpen("C:\FolderName\FileName.xls") Then...
Dim f As Integer
    f = FreeFile
    On Error Resume Next
    Open FullFileName For Binary Access Read Write Lock Read Write As #f
    Close #f
    ' If an error occurs, the document is currently open.
    If Err.Number <> 0 Then
        FileAlreadyOpen = True
        Err.Clear
        'MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
    Else
        FileAlreadyOpen = False
    End If
    On Error GoTo 0
End Function

Much appreciated if you can help

C

 

[Andrew Poulsom]

Try replacing:

    If Err.Number > 0 Then Set wb = Workbooks.Open(fileName:=filep, Local:=True)

with:

    If Err.Number > 0 Then
        If FileAlreadyOpen(filep) Then Exit Sub
    Else
        Set wb = Workbooks.Open(Filename:=filep, Local:=True)
    End If

 

[ClimoC]

Thanks Andrew.