Aanpassen script dat gegevens uit AD in document plaatst

[claujoo]

Een vroegere collega van mij heeft een script geschreven waarin gegevens van de actieve gebruiker vanuit de Active Directory in een Word-document geplaatst worden middels bookmarks in dat Word document. Hier volgt een deel van het script:

Code:

Sub FaxVoorblad()

Dim X

set X = createobject("WSCRIPT.Network")

dim U

dim vannaam

dim postOfficeBox

dim telephoneNumber

dim mobile

dim vanfaxnummer

dim aannaam

dim aantav

dim aanfaxnummer

dim aantalpaginas

dim datum

dim onderwerp

dim aanhef

dim tekst

dim groet

dim functie

dim mobiel

U=X.UserName

ADS_CHASE_REFERRALS_NEVER = &00

ADS_CHASE_REFERRALS_SUBORDINATE = &20

ADS_CHASE_REFERRALS_EXTERNAL = &40

ADS_CHASE_REFERRALS_ALWAYS = &60

ADS_SCOPE_BASE = 0

ADS_SCOPE_ONELEVEL = 1

ADS_SCOPE_SUBTREE = 2

'Get Distinguished Name for local domain

Set RootDSE = GetObject("LDAP://RootDSE")

domainDN = RootDSE.Get("DefaultNamingContext")

'Initialize ADO connection

Set connection = CreateObject("ADODB.Connection")

connection.Provider = "ADsDSOObject"

connection.open

Set command = CreateObject("ADODB.Command")

Set command.ActiveConnection = connection

Command.Properties("Page Size") = 1000

Command.Properties("Timeout") = 30

Command.Properties("searchscope") = ADS_SCOPE_SUBTREE

Command.Properties("Chase referrals") = ADS_CHASE_REFERRALS_NEVER

Command.Properties("Cache Results") = False

'via SQL de juiste velden kiezen.

command.CommandText = "SELECT sAMAccountName,title,mail,displayName,postOfficeBox,facsimileTelephoneNumber,st,telephoneNumber,mobile FROM " & "'LDAP://bedrijf-dc3/" & domainDN &"' WHERE objectcategory = 'user' AND sAMAccountName = '" & U & "'"

Set rs = command.Execute

Do Until rs.EOF

vannaam = rs.fields("displayName")

postcode = rs.fields("postOfficeBox")

telefoon = rs.fields("telephoneNumber")

mobiel = rs.fields("mobile")

vanfaxnummer = rs.fields("facsimileTelephoneNumber")

functie = rs.fields("st")

email = rs.fields("mail")

rs.MoveNext

Loop

'Word applicatie opstarten en gelijk fax.doc inlezen

Set objword = CreateObject("Word.Application")

objword.visible = True

Set doc = objword.Documents.Add("\\bedrijf-dc2\bedrijf$\docalg\sjabloonfax.doc")

if (vannaam <> "") then

doc.Bookmarks("vannaam").Range.Text = vannaam

else

doc.Bookmarks("vannaam").Range.Text = ""

end if

if (vanfaxnummer <> "") then

doc.Bookmarks("vanfaxnummer").Range.Text = vanfaxnummer

else

doc.Bookmarks("vanfaxnummer").Range.Text = ""

end if

aannaam = InputBox("Fax gericht aan?")

doc.Bookmarks("aannaam").Range.Text = aannaam

aantav = InputBox("Ter attentie van?")

doc.Bookmarks("aantav").Range.Text = aantav

aanfaxnummer = InputBox("naar welk faxnummer?")

doc.Bookmarks("aanfaxnummer").Range.Text = aanfaxnummer

aantalpaginas = InputBox("Hoeveel pagina's")

doc.Bookmarks("aantalpaginas").Range.Text = aantalpaginas

doc.Bookmarks("datum").Range.Text = date()

onderwerp = InputBox("onderwerp?")

doc.Bookmarks("onderwerp").Range.Text = onderwerp

aanhef = InputBox("aanhef?")

doc.Bookmarks("aanhef").Range.Text = aanhef

tekst = InputBox("begeleidende tekst?")

doc.Bookmarks("tekst").Range.Text = tekst

groet = InputBox("groet?")

doc.Bookmarks("groet").Range.Text = groet

If (vannaam <> "") then

doc.Bookmarks("naamtwee").Range.Text = vannaam

else

doc.Bookmarks("naamtwee").Range.Text = ""

end if

If (functie <> "") then

doc.Bookmarks("functie").Range.Text = functie

else

doc.Bookmarks("functie").Range.Text = ""

end if

If (telefoon <> "") then

doc.Bookmarks("telefoonzaak").Range.Text = telefoon

else

doc.Bookmarks("telefoonzaak").Range.Text = ""

end if

If (mobiel <> "") then

doc.Bookmarks("mobiel").Range.Text = mobiel

else

doc.Bookmarks("mobiel").Range.Text = ""

end if

end Sub

In Word-documenten werkt het prima. Echter ... sinds kort gebruiken we ook een Excel-document waar gegevens uit de AD in tevoorschijn moeten komen. Mijn kennis van programmeren is niet echt heel groot, ik heb al diverse mogelijkheden geprobeerd, helaas nog zonder het gewenste resultaat. Is er iemand die mij er mee kan helpen?

[Verwijderd]

neem eens gewoon een paar macro's op in excel zelf, die manueel ingebrachte informatie in bepaalde cellen plaatst en een excel werkmap opent znz. en bekijk deze. zo heb je meteen een eerste indruk van het excelobjectmodel.
hierbij moet je dan uiteraard ipv word excel instantantiëren dmv. Set objexcel = CreateObject("excel.Application")
deze code ga je dan verder aanpassen en integreren in dit script. de AD-code kan je ongewijzigd overnemen.