• Home
 · 
• Files/File Controls/Input/Output
 · 
• Found out who opened your Word document.

Found out who opened your Word document.

Found out who opened your Word document.

Rate Found out who opened your Word document.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'************************************************************
'Name:      fWhoHasDocFileOpen (Function)
'Purpose:   Returns the network name of the user who has
'           strDocFile open
'Author:    Shorty @ NL (credits to Dev Ashish)
'Inputs:      strDocFile - Complete path to the Word document
'Output:     Name of the user if successful, else no output
'*************************************************************

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 = "Not present, or is not opened by another user..."
  Resume ExitHere
  
End Function

Private Function fFileDirPath(strFile As String) As String

Dim strPath As String
  strPath = DiR(strFile)
  fFileDirPath = Left(strFile, Len(strFile) - Len(strPath))
  
End Function

Public Sub gsExample()

MsgBox fWhoHasDocFileOpen("c:\readme.doc")

End Sub