by Shorty @ NL (2 Submissions)
Category: Files/File Controls/Input/Output
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 25th March 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Found out who opened your Word document.
VBcoders
'************************************************************
'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
