excel - 如何使用 Access VBA 获取在服务器上打开 (Excel) 文件的用户名？

Question

服务器(或网络共享存储位置)上有多个 Excel 文件。

我有一个 Access 文档需要 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 能够做到这一点。 super 用户帖子: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")

注意事项:

1. 这应该在工作表打开失败时使用(因为正在使用中)
2. 我没有找到任何文档说明这是执行此操作的“有效”方法。
3. 我不知道这是否也适用于共享的 Excel 工作表