Question

我想以Access形式显示Active Directory中已登录用户的照片。有没有办法使用VBA做到这一点？谢谢。

Answer 1

Option Explicit

Sub TesterUserPic()
    Debug.Print UserNameToPic("jdoe")
    Debug.Print UserNameToPic("jblow")
End Sub

'return the path to the user's pic so it can be loaded into the form...
Function UserNameToPic(id As String) As String
    Const FPATH As String = "C:\_Stuff\Test\"
    Dim FSO, f, rootDSE, base, fltr, scope, attr
    Dim conn, rs, cmd

    Set rootDSE = GetObject("LDAP://RootDSE")
    base = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">"

    'filter on user objects with the given account name
    fltr = "(&(objectClass=user)(objectCategory=Person)"
    fltr = fltr & "(sAMAccountName=" & id & "))"
    attr = "thumbnailPhoto"
    scope = "subtree"

    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "ADsDSOObject"
    conn.Open "Active Directory Provider"

    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = conn
    cmd.CommandText = base & ";" & fltr & ";" & attr & ";" & scope

    Set rs = cmd.Execute

    If Not rs.EOF Then
        SaveBinaryData FPATH & id & ".jpg", rs(0).Value
        UserNameToPic = FPATH & id & ".jpg"
    End If

    rs.Close
    conn.Close

End Function

Sub BinaryDataToFile(FileName, ByteArray)
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2

    If IsNull(ByteArray) Then Exit Sub

    Dim BinaryStream 'Create Stream object
    Set BinaryStream = CreateObject("ADODB.Stream")
    With BinaryStream
        .Type = adTypeBinary
        .Open
        .Write ByteArray
        .SaveToFile FileName, adSaveCreateOverWrite
    End With
End Sub

以访问表单显示Active Directory中的照片

1 个答案: