AW: Bitte Zeile oCommand.CommandText = nochmal posten
11.02.2010 17:32:59
bst
Auch Hallo,
hier funktioniert das nicht?
Set oRootDSE = GetObject("LDAP://rootDSE")
?err.Number
-2147023541
?err.Description
Automatisierungsfehler
Die angegebene Domäne ist nicht vorhanden oder es konnte keine Verbindung hergestellt werden.
Im Gegesatz dazu funktioniert WinAPI - zuerst GetUserName und damit NetUserGetInfo schon.
Dito WMI. ?
cu, Bernd
--
Option Explicit
Const NERR_Success = 0
Const CP_ACP = 0
Private Type USER_INFO_10
usri10_name As Long
usri10_comment As Long
usri10_usr_comment As Long
usri10_full_name As Long
End Type
' Benutzernamen ermitteln:
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, ByRef Size As Long) As Long
' Benutzerinformationen ermitteln:
Private Declare Function NetUserGetInfo Lib "netapi32" ( _
ByVal ServerName As Long, ByVal Username As Long, ByVal Level As Long, ByRef ptrBuffer As Long) As Long
' Freigabe des von NetUserGetInfo reservierten Speichers:
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (ByVal ptrBuffer As Long) As Long
' Speicherbereiche kopieren:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Size As Long)
' Stringlänge ermitteln
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
' Zeichenkonvertierung
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, _
lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long) As Long
' Returns the string before first null char encountered (if any) from an ANSII string.
Public Function GetStrFromBufferA(sz As String) As String
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function
' Returns an ANSI string from a pointer to a Unicode string.
Public Function GetStrFromPtrW(lpszW As Long) As String
Dim sRtn As String
sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0) ' 2 bytes/char
' WideCharToMultiByte also returns Unicode string length
Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
GetStrFromPtrW = GetStrFromBufferA(sRtn)
End Function
Sub GetFullName()
Dim lpBuf As Long
Dim ui10 As USER_INFO_10
Dim strUserName As String
Dim lngErr As Long
'Create a buffer
strUserName = String(100, Chr$(0))
'Get the username
GetUserName strUserName, 100
'strip the rest of the buffer
strUserName = GetStrFromBufferA(strUserName)
lngErr = NetUserGetInfo(0, StrPtr(strUserName), 10, lpBuf)
If lngErr = NERR_Success Then
Call CopyMemory(ui10, ByVal lpBuf, Len(ui10))
MsgBox GetStrFromPtrW(ui10.usri10_full_name), , strUserName
Call NetApiBufferFree(ByVal lpBuf)
Else
MsgBox "Fehler: " & lngErr
End If
End Sub
sowie:
Option Explicit
Function GetFullName()
Dim WshNetWork As Object, objUser As Object
On Error Resume Next
Set WshNetWork = CreateObject("WScript.Network")
If Not WshNetWork Is Nothing Then
Set objUser = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
WshNetWork.ComputerName & "\root\cimv2:Win32_UserAccount." & _
"Domain='" & WshNetWork.UserDomain & _
"',Name='" & WshNetWork.Username & "'")
If Not objUser Is Nothing Then
GetFullName = objUser.FullName
Set objUser = Nothing
End If
Set WshNetWork = Nothing
End If
End Function
Sub xx()
MsgBox GetFullName
End Sub