Mappage réseau à l aide GPO

Code: Select all
    Dim WshShell
    Dim objNet
    Dim objRootDSE
    Dim Tab
    Dim DN
    Dim i
    Dim strComputer
    DN = ""
    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set objNet = WScript.CreateObject("WScript.Network")' create network object for vars
    Set objRootDSE = GetObject("LDAP://rootDSE")' bind to the rootDSE for portability
    strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")' bind to configuration to get Domain Controllers later
    strRootDSE = objRootDSE.Get("defaultNamingContext")' bind to the defaultContext for portability
    strUserName = UCase(objNet.UserName)' pull user name from environment variable
    Tab =  Split(GetDNUser(strUserName,"person"),",")

    For i=1 to UBound(Tab)
    If i = Ubound(Tab) Then

    DN = DN + Tab(i)
    Else
    DN = DN + Tab(i) + ","
    End If
    Next
    'MsgBox DN
    Const ADS_SCOPE_SUBTREE = 2
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.CommandText = "Select Name, unCName, ManagedBy from " _
        & "'LDAP://"&DN&"' where objectClass='volume'"
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        'Wscript.Echo "Share Name: " & objRecordSet.Fields("Name").Value
        msgbox objRecordSet.Fields("Name").Value
        msgbox objRecordSet.Fields("uNCName").Value

    Dim oNet
    Set oNet = CreateObject("Wscript.Network")
    oNet.MapNetworkDrive objRecordSet.Fields("Name").Value, objRecordSet.Fields("uNCName").Value
    objRecordSet.MoveNext

    Loop

    Function GetDNUser(param1,param2)
      Set objDSE = GetObject("LDAP://rootDSE")
      ON ERROR RESUME NEXT
      Set objConnection = CreateObject("ADODB.Connection")
      objConnection.Open "Provider=ADsDSOObject;"
      Set objCommand = CreateObject("ADODB.Command")
      objCommand.ActiveConnection = objConnection
      objCommand.CommandText = "SELECT distinguishedName, Sn " & "FROM 'LDAP://" & objDSE.Get("defaultNamingContext") & "' " & "WHERE objectCategory='" & param2 & "' AND sAMAccountName='" & param1 & "' " & "ORDER BY sAMAccountName"
      Set objRecordSet = objCommand.Execute
      GetDNUser = objRecordSet.Fields("distinguishedName")
      objConnection.Close
      if err.number <> 0 then
        msgbox "ERREUR: le nom renseigné n'existe pas dans l'AD.",16,Wscript.ScriptName & " " & version
        ERR.CLEAR
        wscript.quit
      end if
    End Function
    MsgBox "Mappage effectué"