Excel links update log

[PATSYS]

Is there a way to log the userid of the person who last made an update in the external file links?

Thanks

 

[Joe Was]

You will need to change the sheet names in the code below. Currently the code logs each user to Sheet2 in the Workbook. It logs:

User ID , Date, Time

One user to a row, newest user at the bottom of the list, each time the WorkBook is opened.


Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" _
(ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
'ThisWorkbook code!

Private Const NO_ERROR = 0&
Private Const ERROR_MORE_DATA = 234&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&

Private Sub Workbook_Open()
'ThisWorkbook code only!
Dim myClrBuffer$, myUser$, logedUser$, myErrTag$
Dim userStatus&

myClrBuffer = Space$(255)
userStatus = WNetGetUser("", myClrBuffer, 255)

If userStatus = 234 Then myErrTag = "ERROR_MORE_DATA"
If userStatus = 1222 Then myErrTag = "ERROR_NO_NETWORK"
If userStatus = 2250 Then myErrTag = "ERROR_NOT_CONNECTED"
If userStatus = 1208 Then myErrTag = "ERROR_EXTENDED_ERROR"
If userStatus = 1203 Then myErrTag = "ERROR_NO_NET_OR_BAD_PATH"

If userStatus = NO_ERROR Then

myUser = Left(myClrBuffer, InStr(myClrBuffer, vbNullChar) - 1)
logedUser = logedUser & "User: " & myUser & ", on: " & Date & ", at: " & Time

Sheets("Sheet2").Range("A1").Value = "Logged Users!"
Sheets("Sheet2").Range("A1").Font.Bold = True

Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).Value = logedUser
Else

Sheets("Sheet2").Range("A1").Value = "Logged Users!"
Sheets("Sheet2").Range("A1").Font.Bold = True

Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).Value = myErrTag & ", " & _
"User: " & myUser & ", on: " & Date & ", at: " & Time
End If

Sheets("Sheet2").Select
Sheets("Sheet2").Range("A65536").End(xlUp).Offset(0, 9).Select
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1").Select
End Sub

 

[PATSYS]

Thanks Joe, I will try it.

 

[btorrean]

Kind folks,

I'm having a similar problem. I have a charting workbook and a data workbook, both of which are open at the same time. In the charting workbook, I'd like to know who has read/write access to the data workbook at any given time. I'd like to have that code in a macro that can be called from a button or another macro. I tried using UserStatus, but that only returns a result if I'm the only one in the data workbook. If others are in it, too, I get a "Run time error '1004'. Cannot access the read-only document 'Z:\Reporting\IBE Scoreboard2.xlsm'. If I use WriteReservedBy, it always thinks that I have read/write access and that I am the reserver of the workbook. Please see below the two examples of code I have tried. Thanks in advance for any help!

Public Sub TestUserCheck()
 
    ' Dimension the variables
    Dim Users As Variant
    Dim Row As Integer
    Dim aDataWbk As Workbook
    Dim aWbk As Workbook
    Dim strBuild As String
    Dim strWbkPath As String
 
    ' Set the variable(s)
    Set aDataWbk = Nothing
    strWbkPath = "Z:\Reporting\IBE Scoreboard2.xlsm"
    strBuild = "For the data workbook: " & strWbkPath & _
        Chr(10) & Chr(13) & "Users =" & Chr(10) & Chr(13) & _
        Chr(10) & Chr(13)
 
    ' Find the workbook.
    For Each aWbk In Excel.Workbooks
        If aWbk.FullName = strWbkPath Then
            ' We've got it!
            Set aDataWbk = aWbk
            Exit For
        End If  ' aWbk.Name...
    Next
    ' If we haven't found it, get out.
    If aDataWbk Is Nothing Then
        Exit Sub
    End If  ' aDataWbk...
 
    ' Find out who's got ownership of the scoreboard.
    ' Let's do it!
    Users = aDataWbk.UserStatus
    ' Let's find out who's in it.
    For Row = 1 To UBound(Users, 1)
        ' Get the user name and add it to the string.
        strBuild = strBuild & Users(Row, 1)
        'strLastAccess = Users(Row, 2)
        Select Case Users(Row, 3)
            Case 1
                ' Exclusive owner.
                strBuild = strBuild & "     Exclusive access" & Chr(10) & Chr(13)
            Case 2
                ' Shared owner.
                strBuild = strBuild & "     Shared access" & Chr(10) & Chr(13)
        End Select
    Next
 
    ' Inform the user
    MsgBox strBuild, vbInformation + vbOKOnly, gstrAppTitle
 
End Sub

<!-- BEGIN TEMPLATE: bbcode_code -->

Public Sub WriteReservedByTest()
 
    ' Dimension the variables
    Dim aDataWbk As Workbook
    Dim aWbk As Workbook
    Dim strWbkPath As String
 
    ' Set the variable(s)
    Set aDataWbk = Nothing
    strWbkPath = "Z:\Reporting\IBE Scoreboard2.xlsm"
 
    ' Find the workbook.
    For Each aWbk In Excel.Workbooks
        If aWbk.FullName = strWbkPath Then
            ' We've got it!
            Set aDataWbk = aWbk
            Exit For
        End If  ' aWbk.Name...
    Next
    ' If we haven't found it, get out.
    If aDataWbk Is Nothing Then
        Exit Sub
    End If  ' aDataWbk...
 
    ' Find out who's got ownership of the scoreboard.
    ' Let's do it!
    If aDataWbk.WriteReserved Then
        MsgBox "The data workbook '" & strWbkPath & "' is write-reserved by: " & _
            aDataWbk.WriteReservedBy & ".", vbInformation + vbOKOnly, gstrAppTitle
    Else
        MsgBox "The data workbook '" & strWbkPath & "' is available for editing.", _
            vbInformation + vbOKOnly, gstrAppTitle
    End If  ' aDataWbk.WriteReserved...
 
End Sub

 

[btorrean]

I forgot to post...I've asked this question on a couple other forums, but have not yet received a reply on either of them. Those posts can be found at:

Excel Forum
http://www.excelforum.com/excel-pro...sers-are-in-a-workbook-on-a-shared-drive.html
Microsoft Answers Forum
http://answers.microsoft.com/en-us/...le-error/94200433-6a9a-4615-bf9a-d5eb2f5ec05d

Brian