Modules: Determining who has Word Doc file open

In order to determine whether a Word document is currently opened by an user, we can try to open the file in code with lock rights.  If our code fails to gain an  exclusive lock on the file, a runtime error will be generated allowing us to conclude that the file is currently opened somewhere else.

'*********** Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fIsDocFileOpen(ByVal strDocFileName As String) As Boolean
'*******************************************
'Name:      fIsDocFileOpen (Function)
'Purpose:   Checks to see if the Word document is already open
'Author:     Dev Ashish
'Date:        February 11, 1999, 05:50:58 PM
'Called by:  Any
'Calls:       None
'Inputs:      strDocFileName: Full path to the Word document
'Output:     True if file is open, false otherwise
'*******************************************
On Error GoTo ErrHandler
Dim intFree As Integer
   intFree = FreeFile()
   Open strDocFileName For Input Lock Read As intFree
   fIsDocFileOpen = False
ExitHere:
   On Error Resume Next
   Close #intFree
   Exit Function
ErrHandler:
   fIsDocFileOpen = True
   Resume ExitHere
End Function
'*********** Code End **********

    By following the same technique of opening the file in code, we can also determine the loginId of the user who has the Word document open.

    Microsoft Word creates a temporary file whose name is the same as the original file, but with ~$ as the leading two characters.  This file contains the loginid of the user who has the Doc file open.  We can open this temporary file in shared mode and retrieve the username.

'*********** Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fWhoHasDocFileOpen(ByVal strDocFile As String) As String
'*******************************************
'Name:      fWhoHasDocFileOpen (Function)
'Purpose:   Returns the network name of the user who has
'              strDocFile open
'Author:     Dev Ashish
'Date:        February 11, 1999, 07:28:13 PM
'Called by: Any
'Calls:       fFileDirPath
'Inputs:      strDocFile - Complete path to the Word document
'Output:     Name of the user if successful,
'               vbNullString on error
'*******************************************
On Error GoTo ErrHandler
Dim intFree As Integer
Dim intPos As Integer
Dim strDoc As String
Dim strFile As String
Dim strExt As String
Dim strUserName As String

  intFree = FreeFile()
  strDoc = Dir(strDocFile)
  intPos = InStr(1, strDoc, ".")
  If intPos > 0 Then
    strFile = Left$(strDoc, intPos - 1)
    strExt = Right$(strDoc, Len(strDoc) - intPos)
  End If
  intPos = 0
  If Len(strFile) > 6 Then
    If Len(strFile) = 7 Then
      strDocFile = fFileDirPath(strDocFile) & "~$" & _
        Mid$(strFile, 2, Len(strFile)) & "." & strExt
    Else
      strDocFile = fFileDirPath(strDocFile) & "~$" & _
        Mid$(strFile, 3, Len(strFile)) & "." & strExt
    End If
  Else
    strDocFile = fFileDirPath(strDocFile) & "~$" & Dir(strDocFile)
  End If
  Open strDocFile For Input Shared As #intFree
  Line Input #intFree, strUserName
  strUserName = Right$(strUserName, Len(strUserName) - 1)
  fWhoHasDocFileOpen = strUserName
ExitHere:
  On Error Resume Next
  Close #intFree
  Exit Function
ErrHandler:
  fWhoHasDocFileOpen = vbNullString
  Resume ExitHere
End Function

Private Function fFileDirPath(strFile As String) As String
'Code courtesy of
'Terry Kreft & Ken Getz
Dim strPath As String
  strPath = Dir(strFile)
  fFileDirPath = Left(strFile, Len(strFile) - Len(strPath))
End Function
'*********** Code End **********