0

I have written the below code in the VBA code sheet.

Private Sub Workbook_Open() MsgBox ("Welcome to Tracker, " & Application.UserName) End Sub

Result is " Welcome to Tracker, Sakaray, Kiran"

I want to track the below details in one of the sheet, when the user opens the sheet.

Username Date & Time Changes

Please help me out. Thank you

1 Answer 1

1

I found this answered elsewhere, but I cannot find that reference right now so I'll give you the solution I'm currently using. For my project, I want a UserAccess sheet to be filled any time a user opens the workbook, but you can easily modify that to update a sheet any time a user accesses the sheet as explained below.

If you want the user's Excel username, Application.UserName works fine. If you want his windows username, you have to put a function in a Module to get the windows username:

Declare PtrSafe Function Get_User_Name Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Then in in ThisWorkbook, I put the following function

Private Sub Workbook_Open()
    Dim wsTemp As Worksheet
    Dim bFound As Boolean
    Dim NxRow As Integer

    'First check to see if the UserAccess sheet exists
    For Each wsTemp In Worksheets
        If wsTemp.Name Like "UserAccess" Then bFound = True: Exit For
    Next

    'If it doesn't exist, add it
    If bFound = False Then Sheets.Add.Name = "UserAccess"

    With Sheets("UserAccess")
        'I like to keep this sheet protected from users editing it, so I unprotect it here first
        .Unprotect "t/c,Anm.QXz;D#9KL@Z$"

        'Find the last empty row on this sheet
        NxRow = .Cells(65536, 1).End(xlUp).Row + 1

        'Fill the cells with data
        .Cells(NxRow, 1).Value = Module1.GetUserName 'this is from the function in Module1
        .Cells(NxRow, 2).Value = DateTime.Now

        'Re-protect the sheet
        .Protect "t/c,Anm.QXz;D#9KL@Z$", UserInterfaceOnly:=True
    End With
End Sub

If you would rather have the macro run when the sheet is accessed (as you mentioned in your question) you could modify the function above and put it in the worksheet's code area in VBA:

Private Sub Worksheet_Activate()    
    Dim NxRow As Integer

    With ActiveSheet
        'Find the last empty row on this sheet
        NxRow = .Cells(65536, 1).End(xlUp).Row + 1

        'Fill the rows with data
        .Cells(NxRow, 1).Value = Application.UserName
        .Cells(NxRow, 2).Value = DateTime.Now
    End With
End Sub   
1
  • its very useful, i tried it is working. Nov 19, 2014 at 19:10

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .