We help IT Professionals succeed at work.

Save Excel File with Specific Computer Name and Username via VBA

Zack
Zack asked
on
Hi EE,


I have series of excel workbooks on Network drives and for the sake of easier cataloging via metadata lookups is their VBA function that will save or make a copy of a workbook assigning specific computer name and username(owner) which can be entered in the VBA code by the user.

Any assistance is appreciated. Using Excel 2013.

Cheers

Thank you.
Comment
Watch Question

NorieAnalyst Assistant

Commented:
Zack

You can get the computer and user names using Environ.
Dim strCompName As String
Dim strUserName AS String

    strCompName = Environ("ComputerName")
    strUserName = "Environ("UserName")

Open in new window

ZackGeneral IT Goto Guy

Author

Commented:
Hi Norie,

Tried those commands they don't seem to be coming through over the network may be it's GPO thing. Is there a way you can set the computer and user name via VBA upon saving the workbook.

Thank you.
NorieAnalyst Assistant

Commented:
Zack

Do you mean set properties of the workbook to reflect the computer/user name?
Roy CoxGroup Finance Manager

Commented:
Does this work?

Computer name:

Option Explicit

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
                                              (ByVal Buffer As String, _
                                               Size As Long) As Long

Sub GetMachineName()
    Dim strBuf As String * 16, strPcName As String, lngPc As Long

    lngPc = GetComputerName(strBuf, Len(strBuf))
    If lngPc <> 0 Then
        strPcName = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
        MsgBox "Your Name of Computer is :" & strPcName
    Else
        MsgBox "Error"
    End If
End Sub

Open in new window


User name:

Option Explicit


Declare Function GetUserName Lib "advapi32.dll" Alias _
                             "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
                             As Long
Sub getUser()


    Dim s As String
    Dim cnt As Long
    Dim dl As Long
    Dim CurUser As String
    cnt = 199
    s = String$(200, 0)
    dl = GetUserName(s, cnt)
    If dl <> 0 Then CurUser = Left$(s, cnt) Else CurUser = ""
    MsgBox CurUser
End Sub

Open in new window

Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:

Tried those commands they don't seem to be coming through over the network

What exactly does that mean?  What values did you get when you accessed those functions, was it real data but not the computer you expected?  Or blank?  Or errors?


Are the users running Excel on a local desktop machine, or is this a virtual desktop configuration?


=========================================================

»bp

Consulting
Distinguished Expert 2017
Commented:
Don't use API, but use the Windows Script Host Library instead.
API should be your last resort.
Public Function GetWindowsCurrentUser() As String
    Dim wsh As Object       '// IWshRuntimeLibrary.WshNetwork
    Set wsh = CreateObject("WScript.Network")
    
    GetWindowsCurrentUser = wsh.userName
End Function

Public Function GetComputerName() As String
    Dim wsh As Object       '// IWshRuntimeLibrary.WshNetwork
    Set wsh = CreateObject("WScript.Network")
    
    GetComputerName = wsh.ComputerName
End Function

Open in new window

ZackGeneral IT Goto Guy

Author

Commented:
Hi Bill,

I just get blank results whenever the scripts listed above, secondly yes the environment is entirely virtualised. I haven't tried Fabrice's script yet I will try it tomorrow.

Thank you.
Fabrice LambertConsulting
Distinguished Expert 2017

Commented:
secondly yes the environment is entirely virtualised
Does that mean users are running Excel on the virtual machine ?
Beware that our solutions will pull data from the computer they are running on, and data pulled from the virtual machine might not be the same as those pulled from a physical one.
ZackGeneral IT Goto Guy

Author

Commented:
Hi Guys,

Fabrice's script works best for most instances which for time being will do :)

Thank you for all your assistance.