Excel links update log

PATSYS

Well-known Member
Joined
Mar 12, 2006
Messages
1,750
Is there a way to log the userid of the person who last made an update in the external file links?

Thanks
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
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
 
Upvote 0
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!

Code:
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 -->
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
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top