如何检查文件对话框中的 Selecteditems 是否已被用户打开？

Question

我需要检查用户通过 msofiledialogopen 选择的工作簿是否已在用户计算机上打开。您如何引用此工作簿而不是使用像 Workbooks("Example.xlsx")?

这样的固定名称

编辑：该文件位于 Sharepoint 上，这可以解释为什么我不能如此轻松地从文件路径中提取名称。

我目前的代码如下所示：

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

Answer 1

这就是我“检查”文件是否在我的工作簿中打开的方式。

请注意，我做的和你几乎一样，除了我首先通过我的两个辅助函数检查文件是否存在，然后尝试打开它以查看它是否已经打开，而不是检查文件名。

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

Answer 2

试试这个（未测试）

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

如何检查文件对话框中的 Selecteditems 是否已被用户打开？

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

excel

vba

filedialog