MS Excel

Ahoj,
lze nějak zjistit ,která IP adresa otevřela sešit ? Pomocí Application.UserName zjistím který vlastník Excelu ,ale někdy to neodovídá skutečnosti , protože jsou tam různá jména a zkratky. Kdyby šlo zjistit ze ,které IP adresy bylo by to super. Každý počítač na naší síti má pevnou IP adresu.

Děkuju Stana V.

Zaslat odpověď >

Barth(23.9.2022 9:48)#053460

API (Get all IP Addresses of your machine) :
https://www.everythingaccess.com/tutorials.asp?ID=Get-all-IP-Addresses-of-your-machine

WMI (Windows Management Instrumentation) :
Public Function getMyIP()
Dim myWMI As Object, myObj As Object, Itm
Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
Set myObj = myWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each Itm In myObj
getMyIP = Itm.IPAddress(0)
Exit Function
Next
End Function

Odkazy :
https://p2p.wrox.com/access-vba/42695-retrieve-system-information-vba.html
https://stackoverflow.com/questions/828496/how-to-retrieve-this-computers-ip-address/949986#949986 citovat

Barth(23.9.2022 10:15)#053461

Nevím, co vlastně vrací Application.UserName ?
Uživatelské zadané při instalaci excelu nebo to samé jako :
username = CreateObject("wscript.shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName")
Přihlašovací jméno :
logname=Environ("USERNAME")
Podle přihlašovacího lze dohledat celé jméno z AD (Active Directory), vrací mi to samé, netuším však zda vždy.citovat

Barth(23.9.2022 12:27)#053462

Application.UserName je zřejmě hodnota z obecných možností Excelu, lze natavit, změnit.

Zkuste ještě:
Function getLDAPName(Optional ByVal username As String)
'
'Declare Variables
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserFullName
Dim intAnswer As Integer
On Error GoTo Err_NoNetwork
' Get current logged in user name
If username = "" Then username = Environ("UserName")

' Get the DN of the user's domain
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")

' Search the domain for the user's account object
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"

Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon

objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & username & "'"

Set objAdoRS = objAdoCmd.Execute

' If found, get the displayName attribute.

If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)

'Get common name
objUser.GetInfoEx Array("CN"), 0
commonName = objUser.Get("CN")

'get first name
objUser.GetInfoEx Array("givenName"), 0
firstName = objUser.Get("givenName")

'get last name
objUser.GetInfoEx Array("SN"), 0
lastName = objUser.Get("SN")

'get display name
objUser.GetInfoEx Array("DisplayName"), 0
DisplayName = objUser.Get("DisplayName")

Set objUser = Nothing
getLDAPName = commonName

Else
' handle "not found" error here
GoTo Err_NoNetwork
End If

Set objAdoRS = Nothing
Set objAdoCmd = Nothing
If objAdoCon.State = 1 Then objAdoCon.Close
Set objAdoCon = Nothing

Set objRootDSE = Nothing
Set WshNetwork = Nothing
GoTo Exit_Sub

Exit_Sub:
Exit Function

Err_NoNetwork:
getLDAPName = "Error"
GoTo Exit_Sub
End Function

https://snipplr.com/view/65503/get-ldap-full-name-from-ldap-username citovat

Stana-V(26.9.2022 8:36)#053463

Děkuju a du na to. SVcitovat

Téma: Která Ip otevřela sešit

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje