Modules: Déterminer qui a ouvert un fichier Doc de Word	Author(s) Dev Ashish

Déterminer qui a ouvert un fichier Doc de Word.

    De façon à déterminer si quelqu'un a un document Word d'ouvert, on peut essayer d'ouvrir ce document en mode exclusif et si on n'y réussi pas, on peut conclure que ce fichier est déjà ouvert par quelqu'un d'autre.

'*********** Code Start **********
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 **********

    Par la même technique, on peut déterminer le LoginId de l'usager qui a le document Word ouvert.

    Microsoft Word crée un fichier temporaire dont le nom commence par  ~$ suivi du nom du fichier ouvert. Ce fichier contient le loginID de l'usager qui a ouvert ce fichier. On peut ouvrir ce fichier temporaire en mode partagé et en récupérer le nom de l'usager.

'*********** Code Start **********

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 **********