Importation dans une basse access

' ------ SCRIPT d'export d'utilisateurs depuis une OU 			------
' ------ Le domaine AD est a jouter en fixe dans le 			------
' ------ String StrDomainDN pour des raisons d'utilisations courantes	------
 
dim fso, MyFile, reptemp, filetext
 
 
Stroucible=inputbox("renseigner le nom de l'ou cible : ")
 
' Attention à modifier le nom LDAP du domaine
strDomainDN ="ou=" & stroucible & ",dc=VotreNomdeDomaine,dc=SonExtention"
 
' Attention le répertoire c:\temp doit exister
reptemp="c:\temp\"
 
Filetext=Inputbox("fichier temporaire de l'OU cible : ")
Set fso = CreateObject("Scripting.FileSystemObject")
 
' création d'un fichier txt pour la première partie du script, soit le nom des utilisateurs
set MyFile = fso.CreateTextFile(reptemp + filetext + ".txt")
 
' Ici un filtre sur les utilisateurs et je récupére leur Distinguishedname
strBase   =  "<LDAP://" & strDomainDN & ">;"
strFilter = "(&(objectclass=user)(objectcategory=person));" 
strAttrs  = "distinguishedname;"
strScope  = "subtree"
 
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
 
' Ici lancement de la requêtes et écriture dans le fichier txt dans le c:\temp
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
while Not objRS.EOF
MyFile.WriteLine (objRS.Fields(0).Value)
    objRS.MoveNext
wend
MyFile.close
 
 
' Maintenant avec le fichier txt je récupère les informations utilisateurs par utilisateurs
on error resume next
Dim objConnection, objRecords, objExcel, strQuery, i, objSpread, intRow
 
'Attention le fichier C:\sources.xls doit exister
strSheet = "c:\Source.xls"
 
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set UserListe = objFSO.OpenTextFile(reptemp + Filetext + ".txt")
 
'Renseigner le numéro de la première ligne Excel ou vous souhaité écrire les inforamations
i = 2
 
  ' liste des attributs à récupérer
  Do Until UserListe.AtEndofStream
	UserLDAP = UserListe.Readline
	Set objUser = GetObject("LDAP://" & UserLDAP & "")
		CNStr = left(UserLDAP, Instr (UserLDAP, ",") -1)
		OuStr = Right(UserLDAP, len(UserLDAP) - Instr (UserLDAP, ","))
		objExcel.ActiveSheet.Range("A" & i).Value = CNStr
		objExcel.ActiveSheet.Range("B" & i).Value = OuStr
		objExcel.ActiveSheet.Range("C" & i).Value = objUser.givenName
		objExcel.ActiveSheet.Range("D" & i).Value = objUser.initials
		objExcel.ActiveSheet.Range("E" & i).Value = objUser.sn
		objExcel.ActiveSheet.Range("F" & i).Value = objUser.displayName	
		objExcel.ActiveSheet.Range("G" & i).Value = objUser.userPrincipalName
		objExcel.ActiveSheet.Range("H" & i).Value = objUser.SamaccountName
		objExcel.ActiveSheet.Range("I" & i).Value = objUser.mail
		objExcel.ActiveSheet.Range("J" & i).Value = objUser.physicalDeliveryOfficeName
		objExcel.ActiveSheet.Range("K" & i).Value = objUser.telephoneNumber
		objExcel.ActiveSheet.Range("L" & i).Value = objUser.Description
 
		i = i + 1
  loop
 
 
 
'Sauvegarde du fichier Excel
objExcel.ActiveWorkbook.SaveAs(reptemp + Filetext + ".xls")
objExcel.ActiveWorkbook.Close
objExcel.Workbooks.Close
 
msgbox "fin de récupération des utilisateurs. Le fichiers excel est dans " + reptemp + Filetext + ".xls"
objExcel.Quit