/* Assign a new Group policy to Organizational Unit */

On Error Resume Next

Set objContainer = GetObject _
    ("LDAP://ou=Sales,dc=NA,dc=fabrikam,dc=com")
 
strExistingGPLink = objContainer.Get("gPLink")
 
strGPODisplayName = "Sales Policy"
strGPOLinkOptions = 2
strNewGPLink = "[" & GetGPOADsPath & ";" & strGPOLinkOptions & "]"
 
objContainer.Put "gPLink", strExistingGPLink & strNewGPLink
objContainer.Put "gPOptions", "0"
 
objContainer.SetInfo
 
Function GetGPOADsPath
    Set objConnection = CreateObject("ADODB.Connection") 
    objConnection.Open "Provider=ADsDSOObject;"  
 
    Set objCommand = CreateObject("ADODB.Command")
    objCommand.ActiveConnection = objConnection
 
    objCommand.CommandText = _
      "<LDAP://cn=Policies,cn=System,dc=NA,dc=fabrikam,dc=com>;;" & _
          "distinguishedName,displayName;onelevel"
    Set objRecordSet = objCommand.Execute
 
    Do Until objRecordSet.EOF
        If objRecordSet.Fields("displayName") = strGPODisplayName Then
          GetGPOADsPath = "LDAP://" & objRecordSet.Fields("distinguishedName")
          objConnection.Close
          Exit Function
        End If
        objRecordSet.MoveNext
    Loop
    objConnection.Close
End Function