如何使用Access VBA獲取在服務器上打開（Excel）文件的用戶名？

Question

服務器（或網絡共享存儲位置）上有多個 Excel 文件。

我有一個 Access 文檔，需要訪問這些 Excel 文件才能執行某個功能。

當這些文件之一打開時，我無法執行我的 VBA 函數。

我檢查是否有人正在使用該文件。 這是在下面的代碼中。

是否也可以找出誰在使用文件。 我會通知他們關閉文件。

我嘗試過的一些東西（這些不是全部，但我再也找不到一些我嘗試過的方法）： https : //chandoo.org/forum/threads/return-user-name-who-has- file-open.31447/ https://www.ozgrid.com/forum/forum/help-forums/excel-general/87346-vba-code-to-determine-who-has-file-open

在最后一個中，他們獲得了文件的所有者，這與當時正在使用該文件的所有者不同。 我試過了，但即便如此，我有時也會得到一個用戶名，但有時會得到一個創建文件的用戶名，有時我會得到一個 SID（安全標識符？）。

用於確定文件是否正在使用的代碼。 這不包括查看誰在使用該文件的任何內容。

Sub TestFileOpened()
    Dim filesArray As Variant
    filesArray = Array("Map1.xlsx", "Map2.xlsx")
    Dim fileLocation As String
    fileLocation = "\\DESKTOP-NETWORK\SharedFolder\NetwerkTest\"
    Dim message As String
    
    For Each file In filesArray
        If IsFileOpen(fileLocation & file) Then
            message = message & vbNewLine & "File '" & file & "' is open!"
        'Else
        '    message = message & vbNewLine & "File '" & file & "' is closed!"
        End If
    Next file
    
    MsgBox message
    
End Sub

檢查文件是否正在使用的函數：

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    
    On Error Resume Next
    filenum = FreeFile()
    
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    
    Select Case errnum
        Case 0
            IsFileOpen = False
        Case 70
            IsFileOpen = True
        Case Else
            Error errnum
    End Select
End Function

當您嘗試手動打開文件時，Access 和 Excel 能夠做到這一點。 超級用戶帖子： https : //superuser.com/questions/845084/how-to-get-excel-to-show-username-of-person-that-has-file-open

Answer 1

好吧，我不擅長編寫下降宏的，所以修改代碼以滿足你自己的需要！

這個應該給出當前打開 Excel 工作表的用戶的姓名：

Sub InUse(filename As String)
    Dim f
    Dim i
    Dim x
    Dim inUseBy
    Dim tempfile
    tempfile = Environ("TEMP") + "\tempfile" + CStr(Int(Rnd * 1000))
    
    f = FreeFile
    i = InStrRev(filename, "\")
    If (i > 0) Then
        filename = Mid(filename, 1, i) + "~$" + Mid(filename, 1 + i)
    Else
        filename = "~$" + filename
    End If
    
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile filename, tempfile
    
    Open tempfile For Binary Access Read As #f
    Input #f, x
    Close (f)
    inUseBy = Mid(x, 2, Asc(x))
    fso.Deletefile tempfile
    Set fso = Nothing

    MsgBox "InUse by: " + inUseBy, vbOKOnly, "InUse"
    
End Sub

使用示例：

InUse("T:\Book1.xlsx")

注意事項：

0. 這應該在打開紙張失敗時使用（因為正在使用）
1. 我沒有找到任何關於這是執行此操作的“有效”方式的文檔。
2. 我不知道這是否也適用於共享的 Excel 表格