Как проверить кто открыл файл Word? - VB

Формулировка задачи:

Программа пишет данные в Word, но иногда некоторые юзвери забывают закрыть Word. В общем требуется проверить кто именно (не только сам факт, что он открыт) открыл файл ну и сообщить об этом юзверю. Есть идеи?

Решение задачи: «Как проверить кто открыл файл Word?»

textual
                            Листинг программы 
                        

                            Option Explicit

Sub btnCheck()
Dim strFileToOpen As String
strFileToOpen = ActiveSheet.Cells(1, 1)

    If Not DocExists(strFileToOpen) Then
        MsgBox strFileToOpen & " does not exist."
        Exit Sub
    End If

    If IsFileOpen(strFileToOpen) Then
        MsgBox strFileToOpen & " is already Open" & _
        vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
        MsgBox ActiveWorkbook.WriteReservedBy
    Else
        MsgBox strFileToOpen & " is not open"
        MsgBox ActiveWorkbook.WriteReservedBy
    End If

End Sub

Function DocExists(ByVal mydoc As String) As Boolean
    On Error Resume Next
    If Dir(mydoc) <> "" Then
        DocExists = True
    Else
        DocExists = False
    End If
End Function

Function IsFileOpen(strFullPathFileName As String) As Boolean
Dim hdlFile As Long

On Error GoTo Err_hdlr

hdlFile = FreeFile
Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
IsFileOpen = False
Close hdlFile
Exit Function

Err_hdlr:
IsFileOpen = True
Close hdlFile

End Function

Function LastUser(strPathFull As String) As String
Dim intFileNamePosition As Integer
Dim intPathLen As Integer
Dim strPathPart1 As String
Dim strPathPart2 As String
Dim strPath As String
Dim lngTextLen As Long
Dim text As String

On Error GoTo Err_hdlr

intFileNamePosition = InStrRev(strPathFull, "\", -1)
intPathLen = Len(strPathFull)
strPathPart1 = Left(strPathFull, intFileNamePosition)
strPathPart2 = "~$" & Right(strPathFull, intPathLen - intFileNamePosition - 2)
strPath = strPathPart1 & strPathPart2

Open strPath For Binary As #1
lngTextLen = LOF(1)
text = Space(lngTextLen)
Get 1, , text
Close #1
LastUser = Mid(text, 2, lngTextLen - 1)
Exit Function

Err_hdlr:
    MsgBox "Wrong file type! Please contact your system administrator."
    Close #1

End Function

                        