• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

active directory de ki kullanıcı ad soyadı yazdırma

Hamitcan Bey,

internette araştırırken aşağıdaki koda rastladım ve problemim çözüldü, Benim için gereken "GetFullNameOfLoggedUser()" olarak çalışan sonuca ulaşmaktı. Şimdi sadece bu kodu Powerpoint dosyada dosya herhangibir makinada açıldığında otomatik olarak çalıştırmak kaldı. :)

Benim için çok zaman harcadınız, size teşekkürlerimi sunmak benim için bir borçtur. Bu formun üyesi olmak gerçekten bir grur.

saygılarımla.

Private Type ExtendedUserInfo
EUI_name As Long
EUI_password As Long
EUI_password_age As Long
EUI_priv As Long
EUI_home_dir As Long
EUI_comment As Long
EUI_flags As Long
EUI_script_path As Long
EUI_auth_flags As Long
EUI_full_name As Long
EUI_usr_comment As Long
EUI_parms As Long
EUI_workstations As Long
EUI_last_logon As Long
EUI_last_logoff As Long
EUI_acct_expires As Long
EUI_max_storage As Long
EUI_units_per_week As Long
EUI_logon_hours As Long
EUI_bad_pw_count As Long
EUI_num_logons As Long
EUI_logon_server As Long
EUI_country_code As Long
EUI_code_page As Long
End Type

Private Declare Function apiNetGetDCName Lib "netapi32.dll" _
Alias "NetGetDCName" (ByVal servername As Long, _
ByVal DomainName As Long, _
bufptr As Long) As Long

Private Declare Function apiNetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (ByVal buffer As Long) As Long

Private Declare Function apilstrlenW Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long

Private Declare Function apiNetUserGetInfo Lib "netapi32.dll" _
Alias "NetUserGetInfo" (servername As Any, _
username As Any, _
ByVal level As Long, _
bufptr As Long) As Long

Private Declare Sub sapiCopyMem Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&

Function GetFullNameOfLoggedUser(Optional strUserName As String) As String
On Error GoTo Err_GetFullNameOfLoggedUser
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As ExtendedUserInfo
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long

abytPDCName = GetDCName() & vbNullChar
If (Len(strUserName) = 0) Then
strUserName = GetUserName()
End If
abytUserName = strUserName & vbNullChar

lngRet = apiNetUserGetInfo(abytPDCName(0), abytUserName(0), 2, pBuf)
If (lngRet = ERROR_SUCCESS) Then
Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
GetFullNameOfLoggedUser = StrFromPtrW(pTmp.EUI_full_name)
End If

Call apiNetAPIBufferFree(pBuf)

Exit_GetFullNameOfLoggedUser:
Exit Function

Err_GetFullNameOfLoggedUser:
MsgBox Err.Description, vbExclamation
GetFullNameOfLoggedUser = vbNullString
Resume Exit_GetFullNameOfLoggedUser
End Function

Private Function GetUserName() As String
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngRet = apiGetUserName(strUserName, lngLen)
If lngRet Then
GetUserName = Left$(strUserName, lngLen - 1)
End If
End Function

Function GetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte

lngRet = apiNetGetDCName(0, 0, pTmp)
If lngRet = NERR_SUCCESS Then
GetDCName = StrFromPtrW(pTmp)
End If
Call apiNetAPIBufferFree(pTmp)
End Function

Private Function StrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte

lngLen = apilstrlenW(pBuf) * 2
If lngLen Then
ReDim abytBuf(lngLen)
Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
StrFromPtrW = abytBuf
End If
End Function
 
tabi bukodu PPT dosyada her açılışta otomatik çalıştırmana yardımcı olurum derseniz bunada hayır demem yani... :)
 
Son düzenleme:
Değerli arkadaşlar,

Active Directory de kayıtlı bir kullanıcının tam adını ve soyadını gösterebilmek için yaptığım bir sürü araştırmalarım sonucu çeşitli formlardan ve ustalardan derlediğim ve minicik te olsa kendi eklentileriminde olduğu dosyayı ekte bilgierinize sunarım.

Umarım bu derleme aramalarım sırasında bu konudan çok muzdarip bir çok arkadaşa yardımcı olur.

Dosyada bulunan kodlarla ile;

1- Seçtiğiniz bir Klasördeki dosyaların yolu, Linki ve özellikleri
2-Environ kullanılarak environa ait tüm bilgilerin gösterilmesi
3-GetName ve Environ Kullanılarak Temel Kullanıcı bilgilerine erişmek
4-Domain ve Active Directory üzerinden Domain, User Name, User Full Name özelliklerini görmek
5-Ağda Kayıtlı tüm Kullanıcı adlarını ve Full Kullanıcı adlarını görmek
6-Ağda Kayıtlı tüm Kullanıcıların temel bilgilerini görmek

Çalışmayı derlerken yürüttüğü argümanlarla bana aradığımı bulabilmem için fikirler veren Sayın Hamitcan beye, çok önce yapmış olduğu bir kodun ilham vermesi ve temel alınmasına sebep olması ile Sayın Haluk Beye ve bu kodların yazılmasında emeği geçen (malesef internette aynı kodu birden fazla sitede kendine mal eden bir sürü kişi gördüğüm için) o isimsiz kod yazarına çok teşekkür ederim.:dua::bravo:

Saygılarımla.
 

Ekli dosyalar

Merhaba,

Sizin #21 nolu mesajınızda verdiğiniz kodu az önce nette ararken bende buldum. Fakat bu kod bende boş msgbox döndürüyor. Yani sonuç vermedi.
 
Bogachank' Alıntı:
tabi bukodu PPT dosyada her açılışta otomatik çalıştırmana yardımcı olurum derseniz bunada hayır demem yani... :)
Genişletmek için tıkla ...

Bu konuda fazla bilgim yok, kusura bakmayın size yardımcı olamayacağım. Ayrıca yaptığınız çalışma oldukça faydalı, sizi tebrik ederim.
 
Merhaba,

Ben birde aşağıdaki kodu buldum. Denermisiniz.

Kod: 
Sub USER_FULLNAME()
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.username
    Set objUser = GetObject("LDAP://" & strUser)
    strFullName = objUser.Get("displayName")
    MsgBox strFullName
End Sub
 
Korhan bey,

Mükemmel çalışıyor, ellerinize kollarınıza sağlık. Yanlız bir ricam olacak, acaba bunu yukarda gönderdiğim PPT dosyada veya herhangibir PPT dosyada msg box olarak değilde Yazı olarak dosya herhangi bir başka bilgisayarda açıldığında otomatik çalışmasını sağlayabilirmiyiz?

saygılarımla.
 
Hamitcan Bey,

Görüşünüz ve yardımlarınız için çok teşekkür ederim. Ellerinize kollarınıza zekanıza sağlık.

Sağolun, varolun.
 
Merhaba,

Powerpoint programında daha önce hiç makro kullanmadım. Tüm dosyalarda çalışması için eklenti yapmak gerekiyor. Fakat başka bilgisayarlarda da çalışmasını istediğiniz için dosyanın içine uygulamak daha mantıklı gibi görünüyor. Msgbox dışında sunu içinde bir alanda kullanıcı adını görüntüleyebilirmiyiz açıkçası bilmiyorum. Araştırmak gerekir.
 
Korhan Bey,

görüşünüze katılıyorum, zaten amaç yarattığım bir dosyada text box olarak bunun otomatik çalışması, excelden uyarlayarak yürümeye çalışıyorum ama malesef istediğim sonuca ulaşamıyorum. bakalım araştıralım neler çıkacak karşımıza...:mrgreen:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst