CODEWITHSUNDEEP
excelvbafiledialog
RobChez
RobChez

Reputation: 13

How do I check if the Selecteditems from Filedialog is already open by user?

I need to build in a check to see if a workbook that is selected by the user through msofiledialogopen is already open on the users computer. How do you reference this workbook instead of using a fixed name like Workbooks("Example.xlsx")?

edit: The file is located on Sharepoint which may explain why I can't extract the name from the file path so easily.

The code I have so far is shown below:

Dim ItemSelected As String, ItemSelectedName As String
Dim wkb as Workbook

With Application.FileDialog(msoFileDialogOpen) 
    .AllowMultiSelect = False
    .Title = "Select Workbook"
    .ButtonName = ""
    
    ItemSelected = .SelectedItems(1)
    ItemSelectedName = Right$(ItemSelected, Len(ItemSelected) - InStrRev(ItemSelected, "\"))

End With

If Workbooks(ItemSelectedName) Is Nothing Then

Set wkb = Workbooks.Open(ItemSelected)

Else
    MSGBox "File already open"
    Exit Sub
End If

Upvotes: 1

Views: 246

Answers (2)

Super Symmetry
Super Symmetry

Reputation: 2875

Try this (not tested)

Sub trySelectingItem2()
    Dim ItemSelected As String, ItemSelectedName As String
    Dim wkb As Workbook
    
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Title = "Select Workbook"
        .ButtonName = ""
        
        ItemSelected = .SelectedItems(1)
        'ItemSelectedName = Right$(ItemSelected, Len(ItemSelected) - InStrRev(ItemSelected, "\"))
        ItemSelectedName = CreateObject("Scripting.FileSystemObject").GetFilename(ItemSelectedName)
    End With
    
    On Error Resume Next
    Set wkb = Workbooks(ItemSelectedName)
    On Error GoTo 0
    
    If wkb Is Nothing Then
        Set wkb = Workbooks.Open(ItemSelected)
    ElseIf LCase(wkb.FullName) = LCase(ItemSelected) Then
        MsgBox "File already open"
        Exit Sub
    Else
        MsgBox "Another file with matching name is open"
        Exit Sub
    End If
End Sub

Upvotes: 0

eirikdaude
eirikdaude

Reputation: 3254

This is how I go about "checking" if a file is open in one of my workbooks.

Note that I do pretty much the same as you except I first check if the file exists at all through my two helper functions, and then attempt to open it in order to see if it's already open, instead of checking against the file name.

Option Explicit

Sub open_file()
    Dim wbMasterfile As Workbook, wbThisBook As Workbook
    Dim sFullFilePath As String, filnavn As String
    Dim masterfileAlreadOpen As Boolean
    
    sFullFilePath = Trim(ThisWorkbook.Worksheets("Innstillinger").Range("H2"))
    
    filnavn = Right(sFullFilePath, Len(sFullFilePath) - Application.WorksheetFunction.Max( _
                                                        InStrRev(sFullFilePath, "\", -1, vbBinaryCompare), _
                                                        InStrRev(sFullFilePath, "/", -1, vbBinaryCompare)))
    
    If sharepointFileExists(sFullFilePath) Or fileOnDisk(sFullFilePath) Then
            
        ' Open the file if it's not already open
        On Error Resume Next
        Set wbMasterfile = Application.Workbooks(filnavn)
        On Error GoTo 0
        
        If wbMasterfile Is Nothing Then
            Set wbMasterfile = Workbooks.Open(Filename:=sFullFilePath, ReadOnly:=True)
            masterfileAlreadOpen = False
        Else
            masterfileAlreadOpen = True
        End If
            
        ' What you want to do...
        
        If Not wbMasterfile Is Nothing And Not masterfileAlreadOpen Then
            wbMasterfile.Close SaveChanges:=False
        End If
    Else
        MsgBox Prompt:="Check that the filename and -path (in the sheet ""Innstillinger"") are correct.", _
                            Title:="Wrong path or name.", Buttons:=vbExclamation
    End If
    
End Sub ' open_file

Function sharepointFileExists(ByVal strUrl As String) As Boolean
    On Error GoTo ErrorHandler
    Dim oHttp As Object
    
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    oHttp.Open "HEAD", strUrl, False
    oHttp.Send
    'Debug.Print oHttp.Status
    sharepointFileExists = CBool(oHttp.Status = 200)
    Exit Function
ErrorHandler:
    'Debug.Print Err.Number & " - " & Err.Description
    'Debug.Print "Feil: - " & oHttp.Status
    sharepointFileExists = False
End Function ' sharepointFileExists

Function fileOnDisk(ByVal strPath As String) As Boolean
    On Error GoTo ErrorHandler
    
    With CreateObject("Scripting.FileSystemObject")
        fileOnDisk = .FileExists(strPath)
    End With
    Exit Function
ErrorHandler:
    ' Debug.Print Err.Number & " - " & Err.Description
    fileOnDisk = False
End Function ' fileOnDisk

Upvotes: 1

Related Questions