批量添加vpn

也是一个自用的脚本，用了好多年了

On Error Resume Next
Dim OUPath,vpnGroup,i,isFound
Dim Uns 
'把要添加VPN的用户都放这里执行脚本就可以了，多个用户最好命令行执行避免弹出提示。


Uns = "username1 username2" '多个用户直接在引号里面用空格分开就可以了


'这个是搜索路径
Uns = Split(Uns)
OUPath="OU=xxx,OU=xxxx,DC=domain,DC=com"
isFound = False
Dim ADuser,CName,LoginName
'=========================================
'Call CheckVpn(OUPath,LCase(Uns(0)))
For i = LBound(Uns) To UBound(Uns)
Call CheckVpn(OUPath,LCase(Uns(i)))
Next
'=========================================

'--------------遍历用户-------------------
Sub CheckVpn(OUdName,UsrName)

	Const ADS_SCOPE_SUBTREE = 2
	Const ADS_PROPERTY_APPEND = 3
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		objCommand.CommandText = "SELECT distinguishedName,displayName,sAMAccountName FROM 'LDAP://"& OUdName & "' WHERE objectCategory='user' AND msNPAllowDialin <> '*'"
	Set objRecordSet = objCommand.Execute
	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF Or objRecordset.BOF
		CName = objRecordSet.Fields("DisplayName").Value
		LoginName = objRecordSet.Fields("sAMAccountName").Value
		If LCase(LoginName) = UsrName Or LCase(CName) = UsrName Then
		Set ADuser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
			ADuser.Put "msNPAllowDialin", True
	    	ADuser.SetInfo
	    	Set objGroup = GetObject("LDAP://CN=vpnUser,OU=xxxx,DC=domain,DC=com")
			objGroup.PutEx ADS_PROPERTY_APPEND, "member", Array(objRecordSet.Fields("distinguishedName").Value)
	    	objGroup.SetInfo
	    	isFound = True
	    	showResult UsrName
	    	Exit Sub
	    End If
		objRecordSet.MoveNext
	Loop
	
	showResult UsrName
End Sub

'------------------遍历OU----------------
Sub ListSubOUs(strOUDN,UsrName)
		If isFound Then Exit Sub
        Set objRootOU = GetObject("LDAP://" & strOUDN)
        objRootOU.GetInfoEx Array("canonicalName"),0
        strcanonicalName = objRootOU.Get("canonicalName")
'根据OU检查用户
		CheckVpn strOUDN,UsrName
        objRootOU.Filter = Array("organizationalUnit")
        For Each objOU In objRootOU
                Call ListSubOUs(objOU.distinguishedName)
        Next
End Sub

Sub showResult(tarName)
If isFound Then
	WScript.Echo "已经将" & CName&"("& LoginName &")的VPN开通成功"
Else
	WScript.Echo "该用户(" & tarName & ")不存在或者已经开通了VPN"
End If
End Sub