Hente oplysninger fra Active Directory ind i en Wordskabelon?

Hej

Her er noget solid kode

http://www.dbforums.com/microsoft-access/1618143-retrieving-active-directory-contents-vba.html

Tror på at det er 'solid' kode, men jeg skal nok have det skåret lidt mere ud i pap :-)
Jeg kopierede denne kode:

-----------------------------------------------------------------
Private Function queryAD()

Dim rs As Object
Dim uName As String

Dim extensions() As Variant
Dim i As Integer

Public Const adOpenStatic    As Integer = 3
Public Const adLockReadOnly  As Integer = 1
Public Const adCmdUnspecified As Integer = -1

    'Instantiate recordset
    Set rs = CreateObject("ADODB.Recordset")
   
    'Open LDAP recordset
    strSQL = "SELECT userPrincipalName, sAMAccountName, mail, telephoneNumber, otherTelephone " & _
            "FROM 'LDAP://DC=xxxxxx,DC=pri'" & _
            "WHERE objectClass='user' AND objectCategory='Person'"
   
    rs.Open strSQL, "Provider=ADSDSOObject;", adOpenStatic, adLockReadOnly, adCmdUnspecified
   
    'Iterate through recordset
    If Not rs.EOF And Not rs.BOF Then
           
            'If userPrincipalName is null, then uName = "@"
            uName = Nz(rs.fields("userPrincipalName"), "@")
            'Trim everything after, and including, the "@" symbol from uName
            uName = Left(uName, InStr(1, uName, "@") - 1)
            'If uName is blank then use sAMAccountName
            uName = IIf(uName = "", Nz(rs.fields("sAMAccountName"), ""), uName)
           
            'Assign username value to textbox
            Me.txtNTUsername.Value = uName
           
            'Assign email and telephone to textboxes
            Me.txtEmail.Value = Nz(RTrim(rs.fields("mail")), "")
            Me.txtTelephone.Value = Nz(RTrim(rs.fields("telephoneNumber")), "")
           
            'otherTelephone accepts multiple values; and as such it has to be treated differently
            'i.e. as an array
           
            If IsNull(rs.fields("otherTelephone").Value) Then
                Me.txtMobExtension.Value = ""
            Else
                'Assign recordset value to our array variant
                extensions() = rs.fields("otherTelephone").Value
               
                'If there is more than one value in the array
                If UBound(extensions) > 0 Then
                    'Iterate through and append each value to create a semi-colon separated string
                    For i = 0 To UBound(extensions)
                        Me.txtTelExtension.Value = Me.txtTelExtension.Value & extensions(i) & "; "
                    Next i
                Else
                    'Single value
                    Me.txtTelExtension.Value = extensions(0)
                End If
            End If
       
    End If
   
    'Close connection and tidy up
    rs.Close
    Set rs = Nothing
   
End Function
-----------------------------------------------------------------

men den giver hele tiden fejl - det første den siger er syntax error til linien 'Public Const adOpenStatic As Integer = 3'. Det lader til at hjælpe at jeg retter det til 'Const adOpenStatic As Integer = 3', men så siger den 'Sub or function not defined' - og jeg er ikke velbevandret nok i VBA til at regne ud hvad det er jeg skal ændre for at få det til at virke hos mig.

/Anne-Dorthe

Kære Anne-Dorthe,

Prøv at køre disse 2 linier:

Set WSHNetwork = CreateObject("WScript.Network")
MsgBox WSHNetwork.UserName

Og se om du får det du gerne vil have.

Det gør jeg :-)
Kan du hjælpe mig med at få det ind i et bogmærke? Jeg har prøvet med:
------------------------------------------------------------------
Set WSHNetwork = CreateObject("WScript.Network")

      Selection.GoTo what:=wdGoToBookmark, Name:="AD"
      Selection.TypeText WSHNetwork.UserName
----------------------------------------------------------------
men så siger den "Runtime error 5099: Du kan kun specificere en enkelt linje, fodnote, slutnote, kommentar eller felt ad gangen".

Og kan jeg få det fulde navn?
/Anne-Dorthe

Nej det ser rigtig mærkeligt ud,
men til gengæld har jeg fundet nogle
linier som kan hjælpe med Navnet:

    Dim objAdSys, objUser
    Set objAdSys = CreateObject("ADSystemInfo")
    Set objUser = GetObject("LDAP://" & objAdSys.UserName)


    MsgBox (objUser.Get("cn"))
    MsgBox (objUser.Get("displayName"))

Hej andera
Undskyld min lange responstid.
Linierne med navnet virker. Tak for hjælpen.

Mangler dog stadig hjælp til at få det sat ind i et bogmærke, så hvis du eller andre støder på noget, så .... :-)

Hilsen Anne-Dorthe

Kan det tænkes at du ikke har bogmærket AD ?
Ellers synes jeg det set rigtigt ud.
Jeg har lige lavet en makro med goto bogmærket olsen
og det virkede.


selection.goto what:=wdgotobookmark, name:="olsen"

hvad med lige at vise din kode her

Har fået det til at virke.  Tak igen.