Tag Archives: Bulk Modification

Feb 09

ConvertOutlookContactsToAD.vbs

Posted on February 9, 2013 by admin

ConvertOutlookContactsToAD.vbs

'========================================================================= ' ConvertOutlookContactsToAD.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: sigkill@sigkillit.com ' WEB: http://sigkillit.com ' DATE: 2/9/2013 ' REQUIREMENTS: Requires Exchange Tools or CDOEXM.DLL on the computer running ' the script to create Email enabled contacts. The script also uses OLEDB, ' which requires running it with %systemroot%\SysWow64\wscript.exe, ' %systemroot%\SysWow64\cscript.exe, or a 64-bit OLEDB Provider. ' COMMENTS: The script is designed to take an Outlook CSV(DOS) Exported list of ' contacts which is used to create AD contacts. However, not all attributes directly ' translate or have an equivelent. For example, AD only has attributes for a single ' address where Outlook contacts can have business, home, and other addresses. The ' strUserType variable was created to allow you to pick 1 of those 3 options to use ' on the import. ' To use the script export your Outlook contacts to a CSV(DOS) file. Then set the ' variables for the log file (Default is in the same directory as the script), the ' DN of the container you want to create the AD Contacts in, the location of the ' Outlook Exported Contacts CSV file, and the UserType(Business, Home, Other) ' EXAMPLE: Create Contacts with CSV file in the same folder as the script ' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") ' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" ' Dim contactsExport: contactsExport = "export.csv" ' Dim strUserType: strUserType = "Business" ' EXAMPLE: Create Contacts Using the Home Address in the CSV ' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") ' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" ' Dim contactsExport: contactsExport = "export.csv" ' Dim strUserType: strUserType = "Home" ' EXAMPLE: Create Contacts with CSV file in a different folder as the script ' Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") ' Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" ' Dim contactsExport: contactsExport = "C:\scripts\export.csv" ' Dim strUserType: strUserType = "Business" '========================================================================= Option Explicit ' ------ START CONFIGURATION ------ Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" Dim contactsExport: contactsExport = "export.csv" Dim strUserType: strUserType = "Business" 'Business, Home, Other ' ------ END CONFIGURATION ------ Call Logger(strLogFile, "USER:GENERAL, EMAIL, ORGANIZATION, ADDRESS, TELEPHONE", True) Call CreateContacts(contactsExport, contactsDN, strUserType, strLogFile) Wscript.Echo "Finished" Private Sub CreateContacts(strContactsFile, strContactsDN, UserType, strLogFile) On Error Resume Next 'Start Error Handling 'Ensure DN not ADS Path strContactsDN = Replace(strContactsDN,"LDAP://","",1,1,1) 'Grab Contacts With OLEDB - If Using a 64-bit OS you Must Use ' - C:\Windows\SysWow64\wscript.exe OR C:\Windows\SysWow64\cscript.exe ' - Alternatively, use a 64-bit OLEDB Provider (http://www.microsoft.com/en-us/download/details.aspx?id=20065) Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject") Dim objFile: Set objFile = objFSO.GetFile(strContactsFile) Const adOpenStatic = 3 Const adLockOptimistic = 3 Const adCmdText = &H0001 Dim objConnection: Set objConnection = CreateObject("ADODB.Connection") Dim objRecordSet: Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & objFile.ParentFolder & "\;" & _ "Extended Properties=""text;HDR=YES;FMT=Delimited""" objRecordset.Open "SELECT * FROM [" & objFile.Name & "]", objConnection, adOpenStatic, adLockOptimistic, adCmdText If Err.Number <> 0 Then Err.Clear Call Logger(strLogFile, "Error Contacts File Is Already Opened, Quitting Script!", False) End If 'Connect to AD and Get Contacts Container Const ADS_SCOPE_SUBTREE = 2 Dim objConnection2: Set objConnection2 = CreateObject("ADODB.Connection") Dim objCommand: Set objCommand = CreateObject("ADODB.Command") objConnection2.Provider = "ADsDSOObject" objConnection2.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection2 objCommand.Properties("Page Size") = 1000 'Override the Return 1000 Results Default objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'Include Sub OU's objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strContactsDN & "'" Dim objRecordset2: Set objRecordSet2 = objCommand.Execute If Not objRecordSet2.RecordCount > 0 Then Call Logger(strLogFile, "Error Contacts Container Doesn't Exist, Quitting Script!", False) Exit Sub End If Dim objContainer: Set objContainer = GetObject(objRecordSet2.Fields("AdsPath").Value) Dim strResult Dim blnAttributeFound Dim objContact, cFName, cLName, cInitials, cOffice, cWebpage Dim cEmail, cEmailAlias Dim cJobTitle, cDepartment, cCompany Dim cStreet, cCity, cState, cZip, cCountry, cPOBox Dim cHomePhone, cOtherHomePhone, cPager, cMobile, cFax, cOtherFax, cIPPhone, cOtherIPPhone, cTelephone, cOtherTelephone, cNotes Do Until objRecordset.EOF 'Set Contact CN strResult = objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name") & ":" Set objContact = objContainer.Create("Contact","CN=" & objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name")) 'General Attributes (Telephone/Other Telephone Under Telephones Attributes and E-mail Under Email Attributes If Not IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then cFName = objRecordset.Fields.Item("First Name") cLName = objRecordset.Fields.Item("Last Name") objContact.Put "givenName", cFName objContact.Put "SN", cLName objContact.Put "displayname", cFName & " " & cLName Elseif Not IsNull(objRecordset.Fields.Item("First Name")) AND IsNull(objRecordset.Fields.Item("Last Name")) Then cFName = objRecordset.Fields.Item("First Name") objContact.Put "givenName", cFName objContact.Put "displayname", cFName Elseif IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then cLName = objRecordset.Fields.Item("Last Name") objContact.Put "SN", cLName objContact.Put "displayname", cLName End If If Not IsNull(objRecordset.Fields.Item("Initials")) Then cInitials = objRecordset.Fields.Item("Initials") objContact.Put "initials", cInitials End If If Not IsNull(objRecordset.Fields.Item("Office Location")) Then cOffice = objRecordset.Fields.Item("Office Location") objContact.Put "physicalDeliveryOfficeName", cOffice End If If Not IsNull(objRecordset.Fields.Item("Web Page")) Then cWebpage = objRecordset.Fields.Item("Web Page") objContact.Put "wWWHomePage", cWebpage End If objContact.SetInfo If Err.Number <> 0 Then Err.Clear strResult = strResult & "ERROR,ERROR,ERROR,ERROR,ERROR" Else strResult = strResult & "SUCCESS," 'Email Attributes (Assumes First Email) blnAttributeFound = False If Not IsNull(objRecordset.Fields.Item("E-mail Address")) Then blnAttributeFound = True cEmail = objRecordset.Fields.Item("E-mail Address") objContact.Put "Mail", cEmail objContact.MailEnable cEmail End If If Not IsNull(objRecordset.Fields.Item("E-mail Display Name")) Then blnAttributeFound = True cEmailAlias = objRecordset.Fields.Item("E-mail Display Name") objContact.Put "mailNickname", cEmailAlias objContact.MailEnable cEmail End If If blnAttributeFound = True Then objContact.SetInfo End If If Err.Number <> 0 Then Err.Clear strResult = strResult & "ERROR," Else strResult = strResult & "SUCCESS," End If 'Organization Attributes blnAttributeFound = False If Not IsNull(objRecordset.Fields.Item("Job Title")) Then blnAttributeFound = True cJobTitle = objRecordset.Fields.Item("Job Title") objContact.Put "title", cJobTitle End If If Not IsNull(objRecordset.Fields.Item("Department")) Then blnAttributeFound = True cDepartment = objRecordset.Fields.Item("Department") objContact.Put "department", cDepartment End If If Not IsNull(objRecordset.Fields.Item("Company")) Then blnAttributeFound = True cCompany = objRecordset.Fields.Item("Company") objContact.Put "company", cCompany End If If blnAttributeFound = True Then objContact.SetInfo End If If Err.Number <> 0 Then Err.Clear strResult = strResult & "ERROR," Else strResult = strResult & "SUCCESS," End If 'Address Attributes (Add Variable to choose business, home, or other) blnAttributeFound = False Select Case UCase(UserType) Case "BUSINESS" If Not IsNull(objRecordset.Fields.Item("Business Street")) Then blnAttributeFound = True cStreet = objRecordset.Fields.Item("Business Street") If Not IsNull(objRecordset.Fields.Item("Business Street 2")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 2") End If If Not IsNull(objRecordset.Fields.Item("Business Street 3")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 3") End If objContact.Put "streetAddress", cStreet End If If Not IsNull(objRecordset.Fields.Item("Business City")) Then blnAttributeFound = True cCity = objRecordset.Fields.Item("Business City") objContact.Put "l", cCity End If If Not IsNull(objRecordset.Fields.Item("Business State")) Then blnAttributeFound = True cState = objRecordset.Fields.Item("Business State") objContact.Put "st", cState End If If Not IsNull(objRecordset.Fields.Item("Business Postal Code")) Then blnAttributeFound = True cZip = objRecordset.Fields.Item("Business Postal Code") objContact.Put "postalCode", cZip End If If Not IsNull(objRecordset.Fields.Item("Business Country/Region")) Then blnAttributeFound = True cCountry = objRecordset.Fields.Item("Business Country/Region") objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166 End If If Not IsNull(objRecordset.Fields.Item("Business Address PO Box")) Then blnAttributeFound = True cPOBox = objRecordset.Fields.Item("Business Address PO Box") objContact.Put "postOfficeBox", cPOBox End If Case "HOME" If Not IsNull(objRecordset.Fields.Item("Home Street")) Then blnAttributeFound = True cStreet = objRecordset.Fields.Item("Home Street") If Not IsNull(objRecordset.Fields.Item("Home Street 2")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 2") End If If Not IsNull(objRecordset.Fields.Item("Home Street 3")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 3") End If objContact.Put "streetAddress", cStreet End If If Not IsNull(objRecordset.Fields.Item("Home City")) Then blnAttributeFound = True cCity = objRecordset.Fields.Item("Home City") objContact.Put "l", cCity End If If Not IsNull(objRecordset.Fields.Item("Home State")) Then blnAttributeFound = True cState = objRecordset.Fields.Item("Home State") objContact.Put "st", cState End If If Not IsNull(objRecordset.Fields.Item("Home Postal Code")) Then blnAttributeFound = True cZip = objRecordset.Fields.Item("Home Postal Code") objContact.Put "postalCode", cZip End If If Not IsNull(objRecordset.Fields.Item("Home Country/Region")) Then blnAttributeFound = True cCountry = objRecordset.Fields.Item("Home Country/Region") objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166 End If If Not IsNull(objRecordset.Fields.Item("Home Address PO Box")) Then blnAttributeFound = True cPOBox = objRecordset.Fields.Item("Home Address PO Box") objContact.Put "postOfficeBox", cPOBox End If Case "OTHER" If Not IsNull(objRecordset.Fields.Item("Other Street")) Then blnAttributeFound = True cStreet = objRecordset.Fields.Item("Other Street") If Not IsNull(objRecordset.Fields.Item("Other Street 2")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 2") End If If Not IsNull(objRecordset.Fields.Item("Other Street 3")) Then cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 3") End If objContact.Put "streetAddress", cStreet End If If Not IsNull(objRecordset.Fields.Item("Other City")) Then blnAttributeFound = True cCity = objRecordset.Fields.Item("Other City") objContact.Put "l", cCity End If If Not IsNull(objRecordset.Fields.Item("Other State")) Then blnAttributeFound = True cState = objRecordset.Fields.Item("Other State") objContact.Put "st", cState End If If Not IsNull(objRecordset.Fields.Item("Other Postal Code")) Then blnAttributeFound = True cZip = objRecordset.Fields.Item("Other Postal Code") objContact.Put "postalCode", cZip End If If Not IsNull(objRecordset.Fields.Item("Other Country/Region")) Then blnAttributeFound = True cCountry = objRecordset.Fields.Item("Other Country/Region") objContact.Put "co", cCountry 'Note: use co to choose Country Name in ISO3166 End If If Not IsNull(objRecordset.Fields.Item("Other Address PO Box")) Then blnAttributeFound = True cPOBox = objRecordset.Fields.Item("Other Address PO Box") objContact.Put "postOfficeBox", cPOBox End If End Select If blnAttributeFound = True Then objContact.SetInfo End If If Err.Number <> 0 Then Err.Clear strResult = strResult & "ERROR," Else strResult = strResult & "SUCCESS," End If 'Telephone Attributes (Add Variable to choose business, home or other) blnAttributeFound = False If Not IsNull(objRecordset.Fields.Item("Home Phone")) Then blnAttributeFound = True cHomePhone = objRecordset.Fields.Item("Home Phone") objContact.Put "homePhone", cHomePhone End If If Not IsNull(objRecordset.Fields.Item("Home Phone 2")) Then blnAttributeFound = True cOtherHomePhone = objRecordset.Fields.Item("Home Phone 2") objContact.PutEx 3, "otherHomePhone", Array(cOtherHomePhone) End If If Not IsNull(objRecordset.Fields.Item("Pager")) Then blnAttributeFound = True cPager = objRecordset.Fields.Item("Pager") objContact.Put "pager", cPager End If If Not IsNull(objRecordset.Fields.Item("Mobile Phone")) Then blnAttributeFound = True cMobile = objRecordset.Fields.Item("Mobile Phone") objContact.Put "mobile", cMobile End If If Not IsNull(objRecordset.Fields.Item("Business Fax")) Then blnAttributeFound = True cFax = objRecordset.Fields.Item("Business Fax") objContact.Put "facsimileTelephoneNumber", cFax End If If Not IsNull(objRecordset.Fields.Item("Home Fax")) Then blnAttributeFound = True cOtherFax = objRecordset.Fields.Item("Home Fax") objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax) End If If Not IsNull(objRecordset.Fields.Item("Other Fax")) Then blnAttributeFound = True cOtherFax = objRecordset.Fields.Item("Other Fax") objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax) End If If Not IsNull(objRecordset.Fields.Item("Business Phone")) Then blnAttributeFound = True cIPPhone = objRecordset.Fields.Item("Business Phone") objContact.Put "ipPhone", cIPPhone End If If Not IsNull(objRecordset.Fields.Item("Business Phone 2")) Then blnAttributeFound = True cOtherIPPhone = objRecordset.Fields.Item("Business Phone 2") objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone) End If If Not IsNull(objRecordset.Fields.Item("Company Main Phone")) Then blnAttributeFound = True cOtherIPPhone = objRecordset.Fields.Item("Company Main Phone") objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone) End If If Not IsNull(objRecordset.Fields.Item("Primary Phone")) Then blnAttributeFound = True cTelephone = objRecordset.Fields.Item("Primary Phone") objContact.Put "telephoneNumber", cTelephone End If If Not IsNull(objRecordset.Fields.Item("Other Phone")) Then blnAttributeFound = True cOtherTelephone = objRecordset.Fields.Item("Other Phone") objContact.Put "otherTelephone", cOtherTelephone End If If Not IsNull(objRecordset.Fields.Item("Notes")) Then blnAttributeFound = True cNotes = objRecordset.Fields.Item("Notes") objContact.Put "info", cNotes End If If blnAttributeFound = True Then objContact.SetInfo End If If Err.Number <> 0 Then Err.Clear strResult = strResult & "ERROR" Else strResult = strResult & "SUCCESS" End If End If 'Log Results Call Logger(strLogFile, strResult, False) objRecordset.MoveNext Loop objRecordset.Close objRecordset2.Close On Error Goto 0 'End Error Handling End Sub Private Sub Logger(fileName, logMessage, blnNewLog) On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject") Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")) Dim logName If InStr(1,fileName,"\",1) > 0 Then logName = fileName If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then If Not objFSO.FolderExists(logName) Then If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then objFSO.CreateFolder logName 'Create Folder In Current Path Exit Sub Else Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder Exit Sub End If End If Else If Not objFSO.FileExists(logName) Then If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder End If End If End If End If Else logName = scriptPath & fileName End If Dim logFile If blnNewLog = True Then Set logFile = objFSO.CreateTextFile(logName, True) Else If objFSO.FileExists(logName) Then Set logFile = objFSO.OpenTextFile(logName, ForAppending, True) Else Set logFile = objFSO.CreateTextFile(logName, True) End If End If logFile.WriteLine logMessage logFile.Close Set objFSO = Nothing On Error Goto 0 End Sub

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455

'========================================================================= ' ConvertOutlookContactsToAD.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: sigkill@sigkillit.com ' WEB: http://sigkillit.com ' DATE: 2/9/2013 ' REQUIREMENTS: Requires Exchange Tools or CDOEXM.DLL on the computer running ' the script to create Email enabled contacts. The script also uses OLEDB, ' which requires running it with %systemroot%\SysWow64\wscript.exe, ' %systemroot%\SysWow64\cscript.exe, or a 64-bit OLEDB Provider. ' COMMENTS: The script is designed to take an Outlook CSV(DOS) Exported list of ' contacts which is used to create AD contacts. However, not all attributes directly ' translate or have an equivelent. For example, AD only has attributes for a single ' address where Outlook contacts can have business, home, and other addresses. The ' strUserType variable was created to allow you to pick 1 of those 3 options to use ' on the import. ' To use the script export your Outlook contacts to a CSV(DOS) file. Then set the ' variables for the log file (Default is in the same directory as the script), the ' DN of the container you want to create the AD Contacts in, the location of the ' Outlook Exported Contacts CSV file, and the UserType(Business, Home, Other) ' EXAMPLE: Create Contacts with CSV file in the same folder as the script '          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") '          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" '          Dim contactsExport: contactsExport = "export.csv" '          Dim strUserType: strUserType = "Business" ' EXAMPLE: Create Contacts Using the Home Address in the CSV '          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") '          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" '          Dim contactsExport: contactsExport = "export.csv" '          Dim strUserType: strUserType = "Home" ' EXAMPLE: Create Contacts with CSV file in a different folder as the script '          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") '          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" '          Dim contactsExport: contactsExport = "C:\scripts\export.csv" '          Dim strUserType: strUserType = "Business" '========================================================================= Option Explicit ' ------ START CONFIGURATION ------ Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt") Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com" Dim contactsExport: contactsExport = "export.csv" Dim strUserType: strUserType = "Business" 'Business, Home, Other ' ------ END CONFIGURATION ------   Call Logger(strLogFile, "USER:GENERAL, EMAIL, ORGANIZATION, ADDRESS, TELEPHONE", True) Call CreateContacts(contactsExport, contactsDN, strUserType, strLogFile) Wscript.Echo "Finished"   Private Sub CreateContacts(strContactsFile, strContactsDN, UserType, strLogFile)       On Error Resume Next  'Start Error Handling       'Ensure DN not ADS Path     strContactsDN = Replace(strContactsDN,"LDAP://","",1,1,1)         'Grab Contacts With OLEDB - If Using a 64-bit OS you Must Use     ' - C:\Windows\SysWow64\wscript.exe OR C:\Windows\SysWow64\cscript.exe     ' - Alternatively, use a 64-bit OLEDB Provider (http://www.microsoft.com/en-us/download/details.aspx?id=20065)     Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")     Dim objFile: Set objFile = objFSO.GetFile(strContactsFile)     Const adOpenStatic = 3     Const adLockOptimistic = 3     Const adCmdText = &H0001     Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")     Dim objRecordSet: Set objRecordSet = CreateObject("ADODB.Recordset")     objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _         "Data Source=" & objFile.ParentFolder & "\;" & _         "Extended Properties=""text;HDR=YES;FMT=Delimited"""     objRecordset.Open "SELECT * FROM [" & objFile.Name & "]", objConnection, adOpenStatic, adLockOptimistic, adCmdText     If Err.Number <> 0 Then         Err.Clear         Call Logger(strLogFile, "Error Contacts File Is Already Opened, Quitting Script!", False)     End If       'Connect to AD and Get Contacts Container     Const ADS_SCOPE_SUBTREE = 2     Dim objConnection2: Set objConnection2 = CreateObject("ADODB.Connection")     Dim objCommand: Set objCommand = CreateObject("ADODB.Command")     objConnection2.Provider = "ADsDSOObject"     objConnection2.Open "Active Directory Provider"     Set objCommand.ActiveConnection = objConnection2     objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default           objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's     objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strContactsDN & "'"     Dim objRecordset2: Set objRecordSet2 = objCommand.Execute     If Not objRecordSet2.RecordCount > 0 Then         Call Logger(strLogFile, "Error Contacts Container Doesn't Exist, Quitting Script!", False)         Exit Sub     End If     Dim objContainer: Set objContainer = GetObject(objRecordSet2.Fields("AdsPath").Value)     Dim strResult     Dim blnAttributeFound     Dim objContact, cFName, cLName, cInitials, cOffice, cWebpage     Dim cEmail, cEmailAlias     Dim cJobTitle, cDepartment, cCompany     Dim cStreet, cCity, cState, cZip, cCountry, cPOBox     Dim cHomePhone, cOtherHomePhone, cPager, cMobile, cFax, cOtherFax, cIPPhone, cOtherIPPhone, cTelephone, cOtherTelephone, cNotes     Do Until objRecordset.EOF         'Set Contact CN         strResult = objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name") & ":"         Set objContact = objContainer.Create("Contact","CN=" & objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name"))           'General Attributes (Telephone/Other Telephone Under Telephones Attributes and E-mail Under Email Attributes         If Not IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then             cFName = objRecordset.Fields.Item("First Name")             cLName = objRecordset.Fields.Item("Last Name")             objContact.Put "givenName", cFName             objContact.Put "SN", cLName             objContact.Put "displayname", cFName & " " & cLName         Elseif Not IsNull(objRecordset.Fields.Item("First Name")) AND IsNull(objRecordset.Fields.Item("Last Name")) Then             cFName = objRecordset.Fields.Item("First Name")             objContact.Put "givenName", cFName             objContact.Put "displayname", cFName         Elseif IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then             cLName = objRecordset.Fields.Item("Last Name")             objContact.Put "SN", cLName             objContact.Put "displayname", cLName                   End If         If Not IsNull(objRecordset.Fields.Item("Initials")) Then             cInitials = objRecordset.Fields.Item("Initials")             objContact.Put "initials", cInitials         End If         If Not IsNull(objRecordset.Fields.Item("Office Location")) Then             cOffice = objRecordset.Fields.Item("Office Location")             objContact.Put "physicalDeliveryOfficeName", cOffice         End If         If Not IsNull(objRecordset.Fields.Item("Web Page")) Then             cWebpage = objRecordset.Fields.Item("Web Page")             objContact.Put "wWWHomePage", cWebpage         End If         objContact.SetInfo         If Err.Number <> 0 Then             Err.Clear             strResult = strResult & "ERROR,ERROR,ERROR,ERROR,ERROR"         Else             strResult = strResult & "SUCCESS,"               'Email Attributes (Assumes First Email)             blnAttributeFound = False             If Not IsNull(objRecordset.Fields.Item("E-mail Address")) Then                 blnAttributeFound = True                 cEmail = objRecordset.Fields.Item("E-mail Address")                 objContact.Put "Mail", cEmail                 objContact.MailEnable cEmail             End If             If Not IsNull(objRecordset.Fields.Item("E-mail Display Name")) Then                 blnAttributeFound = True                 cEmailAlias = objRecordset.Fields.Item("E-mail Display Name")                 objContact.Put "mailNickname", cEmailAlias                 objContact.MailEnable cEmail             End If             If blnAttributeFound = True Then                 objContact.SetInfo             End If             If Err.Number <> 0 Then                 Err.Clear                 strResult = strResult & "ERROR,"             Else                 strResult = strResult & "SUCCESS,"             End If               'Organization Attributes             blnAttributeFound = False             If Not IsNull(objRecordset.Fields.Item("Job Title")) Then                 blnAttributeFound = True                 cJobTitle = objRecordset.Fields.Item("Job Title")                 objContact.Put "title", cJobTitle             End If             If Not IsNull(objRecordset.Fields.Item("Department")) Then                 blnAttributeFound = True                 cDepartment = objRecordset.Fields.Item("Department")                 objContact.Put "department", cDepartment             End If             If Not IsNull(objRecordset.Fields.Item("Company")) Then                 blnAttributeFound = True                 cCompany = objRecordset.Fields.Item("Company")                 objContact.Put "company", cCompany             End If             If blnAttributeFound = True Then                 objContact.SetInfo             End If             If Err.Number <> 0 Then                 Err.Clear                 strResult = strResult & "ERROR,"             Else                 strResult = strResult & "SUCCESS,"             End If               'Address Attributes (Add Variable to choose business, home, or other)             blnAttributeFound = False             Select Case UCase(UserType)             Case "BUSINESS"                 If Not IsNull(objRecordset.Fields.Item("Business Street")) Then                     blnAttributeFound = True                     cStreet = objRecordset.Fields.Item("Business Street")                     If Not IsNull(objRecordset.Fields.Item("Business Street 2")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 2")                     End If                     If Not IsNull(objRecordset.Fields.Item("Business Street 3")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 3")                     End If                     objContact.Put "streetAddress", cStreet                 End If                 If Not IsNull(objRecordset.Fields.Item("Business City")) Then                     blnAttributeFound = True                     cCity = objRecordset.Fields.Item("Business City")                     objContact.Put "l", cCity                 End If                 If Not IsNull(objRecordset.Fields.Item("Business State")) Then                     blnAttributeFound = True                     cState = objRecordset.Fields.Item("Business State")                     objContact.Put "st", cState                 End If                 If Not IsNull(objRecordset.Fields.Item("Business Postal Code")) Then                     blnAttributeFound = True                     cZip = objRecordset.Fields.Item("Business Postal Code")                     objContact.Put "postalCode", cZip                 End If                 If Not IsNull(objRecordset.Fields.Item("Business Country/Region")) Then                     blnAttributeFound = True                     cCountry = objRecordset.Fields.Item("Business Country/Region")                     objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166                 End If                 If Not IsNull(objRecordset.Fields.Item("Business Address PO Box")) Then                     blnAttributeFound = True                     cPOBox = objRecordset.Fields.Item("Business Address PO Box")                     objContact.Put "postOfficeBox", cPOBox                 End If             Case "HOME"                 If Not IsNull(objRecordset.Fields.Item("Home Street")) Then                     blnAttributeFound = True                     cStreet = objRecordset.Fields.Item("Home Street")                     If Not IsNull(objRecordset.Fields.Item("Home Street 2")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 2")                     End If                     If Not IsNull(objRecordset.Fields.Item("Home Street 3")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 3")                     End If                     objContact.Put "streetAddress", cStreet                 End If                 If Not IsNull(objRecordset.Fields.Item("Home City")) Then                     blnAttributeFound = True                     cCity = objRecordset.Fields.Item("Home City")                     objContact.Put "l", cCity                 End If                 If Not IsNull(objRecordset.Fields.Item("Home State")) Then                     blnAttributeFound = True                     cState = objRecordset.Fields.Item("Home State")                     objContact.Put "st", cState                 End If                 If Not IsNull(objRecordset.Fields.Item("Home Postal Code")) Then                     blnAttributeFound = True                     cZip = objRecordset.Fields.Item("Home Postal Code")                     objContact.Put "postalCode", cZip                 End If                 If Not IsNull(objRecordset.Fields.Item("Home Country/Region")) Then                     blnAttributeFound = True                     cCountry = objRecordset.Fields.Item("Home Country/Region")                     objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166                 End If                 If Not IsNull(objRecordset.Fields.Item("Home Address PO Box")) Then                     blnAttributeFound = True                     cPOBox = objRecordset.Fields.Item("Home Address PO Box")                     objContact.Put "postOfficeBox", cPOBox                 End If             Case "OTHER"                 If Not IsNull(objRecordset.Fields.Item("Other Street")) Then                     blnAttributeFound = True                     cStreet = objRecordset.Fields.Item("Other Street")                     If Not IsNull(objRecordset.Fields.Item("Other Street 2")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 2")                     End If                     If Not IsNull(objRecordset.Fields.Item("Other Street 3")) Then                         cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 3")                     End If                     objContact.Put "streetAddress", cStreet                 End If                 If Not IsNull(objRecordset.Fields.Item("Other City")) Then                     blnAttributeFound = True                     cCity = objRecordset.Fields.Item("Other City")                     objContact.Put "l", cCity                 End If                 If Not IsNull(objRecordset.Fields.Item("Other State")) Then                     blnAttributeFound = True                     cState = objRecordset.Fields.Item("Other State")                     objContact.Put "st", cState                 End If                 If Not IsNull(objRecordset.Fields.Item("Other Postal Code")) Then                     blnAttributeFound = True                     cZip = objRecordset.Fields.Item("Other Postal Code")                     objContact.Put "postalCode", cZip                 End If                 If Not IsNull(objRecordset.Fields.Item("Other Country/Region")) Then                     blnAttributeFound = True                     cCountry = objRecordset.Fields.Item("Other Country/Region")                     objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166                 End If                 If Not IsNull(objRecordset.Fields.Item("Other Address PO Box")) Then                     blnAttributeFound = True                     cPOBox = objRecordset.Fields.Item("Other Address PO Box")                     objContact.Put "postOfficeBox", cPOBox                 End If             End Select             If blnAttributeFound = True Then                 objContact.SetInfo             End If             If Err.Number <> 0 Then                 Err.Clear                 strResult = strResult & "ERROR,"             Else                 strResult = strResult & "SUCCESS,"             End If               'Telephone Attributes (Add Variable to choose business, home or other)             blnAttributeFound = False             If Not IsNull(objRecordset.Fields.Item("Home Phone")) Then                 blnAttributeFound = True                 cHomePhone = objRecordset.Fields.Item("Home Phone")                 objContact.Put "homePhone", cHomePhone             End If             If Not IsNull(objRecordset.Fields.Item("Home Phone 2")) Then                 blnAttributeFound = True                 cOtherHomePhone = objRecordset.Fields.Item("Home Phone 2")                 objContact.PutEx 3, "otherHomePhone", Array(cOtherHomePhone)             End If             If Not IsNull(objRecordset.Fields.Item("Pager")) Then                 blnAttributeFound = True                 cPager = objRecordset.Fields.Item("Pager")                 objContact.Put "pager", cPager             End If             If Not IsNull(objRecordset.Fields.Item("Mobile Phone")) Then                 blnAttributeFound = True                 cMobile = objRecordset.Fields.Item("Mobile Phone")                 objContact.Put "mobile", cMobile             End If             If Not IsNull(objRecordset.Fields.Item("Business Fax")) Then                 blnAttributeFound = True                 cFax = objRecordset.Fields.Item("Business Fax")                 objContact.Put "facsimileTelephoneNumber", cFax             End If             If Not IsNull(objRecordset.Fields.Item("Home Fax")) Then                 blnAttributeFound = True                 cOtherFax = objRecordset.Fields.Item("Home Fax")                 objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)             End If             If Not IsNull(objRecordset.Fields.Item("Other Fax")) Then                 blnAttributeFound = True                 cOtherFax = objRecordset.Fields.Item("Other Fax")                 objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)             End If             If Not IsNull(objRecordset.Fields.Item("Business Phone")) Then                 blnAttributeFound = True                 cIPPhone = objRecordset.Fields.Item("Business Phone")                 objContact.Put "ipPhone", cIPPhone             End If             If Not IsNull(objRecordset.Fields.Item("Business Phone 2")) Then                 blnAttributeFound = True                 cOtherIPPhone = objRecordset.Fields.Item("Business Phone 2")                 objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)             End If             If Not IsNull(objRecordset.Fields.Item("Company Main Phone")) Then                 blnAttributeFound = True                 cOtherIPPhone = objRecordset.Fields.Item("Company Main Phone")                 objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)             End If             If Not IsNull(objRecordset.Fields.Item("Primary Phone")) Then                 blnAttributeFound = True                 cTelephone = objRecordset.Fields.Item("Primary Phone")                 objContact.Put "telephoneNumber", cTelephone             End If             If Not IsNull(objRecordset.Fields.Item("Other Phone")) Then                 blnAttributeFound = True                 cOtherTelephone = objRecordset.Fields.Item("Other Phone")                 objContact.Put "otherTelephone", cOtherTelephone             End If             If Not IsNull(objRecordset.Fields.Item("Notes")) Then                 blnAttributeFound = True                 cNotes = objRecordset.Fields.Item("Notes")                 objContact.Put "info", cNotes             End If             If blnAttributeFound = True Then                 objContact.SetInfo             End If             If Err.Number <> 0 Then                 Err.Clear                 strResult = strResult & "ERROR"             Else                 strResult = strResult & "SUCCESS"             End If         End If           'Log Results         Call Logger(strLogFile, strResult, False)               objRecordset.MoveNext     Loop       objRecordset.Close     objRecordset2.Close       On Error Goto 0  'End Error Handling   End Sub   Private Sub Logger(fileName, logMessage, blnNewLog)       On Error Resume Next       Const ForReading = 1, ForWriting = 2, ForAppending = 8     Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")     Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))     Dim logName     If InStr(1,fileName,"\",1) > 0 Then         logName = fileName         If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then             If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then                 If Not objFSO.FolderExists(logName) Then                     If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then                         objFSO.CreateFolder logName 'Create Folder In Current Path                         Exit Sub                     Else                         Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder                         Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder                         Exit Sub                     End If                 End If             Else                 If Not objFSO.FileExists(logName) Then                     If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then                         Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder                         Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder                     End If                 End If             End If         End If     Else         logName = scriptPath & fileName     End If     Dim logFile     If blnNewLog = True Then         Set logFile = objFSO.CreateTextFile(logName, True)     Else         If objFSO.FileExists(logName) Then             Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)         Else             Set logFile = objFSO.CreateTextFile(logName, True)         End If     End If     logFile.WriteLine logMessage     logFile.Close     Set objFSO = Nothing       On Error Goto 0   End Sub

 

Jan 04

GroupModifyManager.vbs

Posted on January 4, 2013 by admin

GroupModifyManager.vbs

'========================================================================= ' GroupModifyManager.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: sigkill@sigkillit.com ' WEB: http://sigkillit.com ' DATE: 1/4/2013 ' COMMENTS: This will set the manager for a group and optionally allow them ' to update group membership. Set the manager by specificying the LDAP path ' or DN of the user you want to set. Set the group to modify by specifying ' the LDAP path or DN of a specific group; you can also set this to an OU ' to make bulk changes. Last, specify whether the manager can update the ' group membership by setting the True/False value. ' EXAMPLE: Modify a Specific Group's Manager and Allow Them to Update Membership ' Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" ' Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com" ' Dim blnUpdateMembership: blnUpdateMembership = True ' EXAMPLE: Modify a Specific Group's Manager and Do Not Allow Them to Update Membership ' Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" ' Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com" ' Dim blnUpdateMembership: blnUpdateMembership = False ' EXAMPLE: Bulk Modify All Group's Managers in an OU and Allow Them to Update Membership ' Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" ' Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com" ' Dim blnUpdateMembership: blnUpdateMembership = True '========================================================================= Option Explicit ' ------ START CONFIGURATION ------ Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com" Dim blnUpdateMembership: blnUpdateMembership = True ' ------ END CONFIGURATION ------ Dim strLogName: strLogName = Replace(WScript.ScriptName,".vbs",".txt") Call Logger(strLogName, "", True) Call ModifyManger(strGroupPath, strManager, blnUpdateMembership, strLogName) Wscript.Echo "Finished" Private Sub ModifyManger(groupPath, groupManager, groupUpdateMembership, groupLogName) On Error Resume Next 'Ensure DN not ADS Path groupPath = Replace(groupPath,"LDAP://","",1,1,1) groupManager = Replace(groupManager,"LDAP://","",1,1,1) 'Constants/Variables to Set Manager Update List Access Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5 Const ADS_RIGHT_DS_WRITE_PROP = &H20 Const ADS_ACEFLAG_INHERIT_ACE = &H00002 'Not Needed but Kept it here for Reference Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0 Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01 Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}" Dim objSecurityDescriptor, objDACL, objUser, objACE 'Connect to AD Dim objConnection: Set objConnection = CreateObject("ADODB.Connection") Dim objCommand: Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000 'Override the Return 1000 Results Default Const ADS_SCOPE_SUBTREE = 2 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'Include Sub OU's objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strGroupPath & "' WHERE objectClass='group'" Dim objRecordSet: Set objRecordSet = objCommand.Execute If Not objRecordSet.RecordCount > 0 Then Call Logger(groupLogName, "Error No Groups Found Quitting Script!", False) Exit Sub End If objRecordSet.MoveFirst Dim objGroup Do Until objRecordSet.EOF Call Logger(groupLogName, objRecordSet.Fields("ADsPath").Value & vbCrLf & "**********************************************", False) Set objGroup = GetObject(objRecordSet.Fields("ADsPath").Value) objGroup.Put "managedBy", groupManager objGroup.SetInfo If Err.Number <> 0 Then Err.Clear Call Logger(groupLogName, "Error Updating Manager to: " & groupManager, False) Else Call Logger(groupLogName, "Success Updating Manager to: " & groupManager, False) If groupUpdateMembership = True Then 'Allow Manager to Update Member List Call Logger(groupLogName, "Allow Manager to Update Member List: True", False) Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor") Set objDACL = objSecurityDescriptor.DiscretionaryACL Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy")) Set objACE = CreateObject("AccessControlEntry") objACE.Trustee = "snapretail\" & objUser.Get("sAMAccountName") objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP objACE.AceFlags = ADS_ACEFLAG_DONT_INHERIT_ACE objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT objACE.objectType = ADS_OBJECT_WRITE_MEMBERS objDACL.AddAce(objACE) objSecurityDescriptor.DiscretionaryACL = objDACL objGroup.Put "ntSecurityDescriptor", Array(objSecurityDescriptor) objGroup.SetInfo If Err.Number <> 0 Then Err.Clear Call Logger(groupLogName, "Error Allowing Manager to Update Member List", False) Else Call Logger(groupLogName, "Success Allowing Manager to Update Member List", False) End If End If End If Call Logger(groupLogName, "" & vbCrLf, False) objRecordSet.MoveNext Loop On Error Goto 0 End Sub Private Sub Logger(fileName, logMessage, blnNewLog) On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject") Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")) Dim logName If InStr(1,fileName,"\",1) > 0 Then logName = fileName If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then If Not objFSO.FolderExists(logName) Then If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then objFSO.CreateFolder logName 'Create Folder In Current Path Exit Sub Else Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder Exit Sub End If End If Else If Not objFSO.FileExists(logName) Then If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder End If End If End If End If Else logName = scriptPath & fileName End If Dim logFile If blnNewLog = True Then Set logFile = objFSO.CreateTextFile(logName, True) Else If objFSO.FileExists(logName) Then Set logFile = objFSO.OpenTextFile(logName, ForAppending, True) Else Set logFile = objFSO.CreateTextFile(logName, True) End If End If logFile.WriteLine logMessage logFile.Close Set objFSO = Nothing On Error Goto 0 End Sub

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169

'========================================================================= ' GroupModifyManager.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: sigkill@sigkillit.com ' WEB: http://sigkillit.com ' DATE: 1/4/2013 ' COMMENTS: This will set the manager for a group and optionally allow them ' to update group membership. Set the manager by specificying the LDAP path ' or DN of the user you want to set. Set the group to modify by specifying ' the LDAP path or DN of a specific group; you can also set this to an OU ' to make bulk changes. Last, specify whether the manager can update the ' group membership by setting the True/False value. ' EXAMPLE: Modify a Specific Group's Manager and Allow Them to Update Membership '          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" '          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com" '          Dim blnUpdateMembership: blnUpdateMembership = True ' EXAMPLE: Modify a Specific Group's Manager and Do Not Allow Them to Update Membership '          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" '          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com" '          Dim blnUpdateMembership: blnUpdateMembership = False ' EXAMPLE: Bulk Modify All Group's Managers in an OU and Allow Them to Update Membership '          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" '          Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com" '          Dim blnUpdateMembership: blnUpdateMembership = True '========================================================================= Option Explicit ' ------ START CONFIGURATION ------ Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com" Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com" Dim blnUpdateMembership: blnUpdateMembership = True ' ------ END CONFIGURATION ------   Dim strLogName: strLogName = Replace(WScript.ScriptName,".vbs",".txt") Call Logger(strLogName, "", True) Call ModifyManger(strGroupPath, strManager, blnUpdateMembership, strLogName) Wscript.Echo "Finished"   Private Sub ModifyManger(groupPath, groupManager, groupUpdateMembership, groupLogName)       On Error Resume Next       'Ensure DN not ADS Path     groupPath = Replace(groupPath,"LDAP://","",1,1,1)     groupManager = Replace(groupManager,"LDAP://","",1,1,1)       'Constants/Variables to Set Manager Update List Access     Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5     Const ADS_RIGHT_DS_WRITE_PROP = &H20     Const ADS_ACEFLAG_INHERIT_ACE = &H00002 'Not Needed but Kept it here for Reference     Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0     Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01     Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}"     Dim objSecurityDescriptor, objDACL, objUser, objACE       'Connect to AD     Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")     Dim objCommand: Set objCommand = CreateObject("ADODB.Command")     objConnection.Provider = "ADsDSOObject"     objConnection.Open "Active Directory Provider"     Set objCommand.ActiveConnection = objConnection     objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default     Const ADS_SCOPE_SUBTREE = 2     objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's     objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strGroupPath & "' WHERE objectClass='group'"     Dim objRecordSet: Set objRecordSet = objCommand.Execute     If Not objRecordSet.RecordCount > 0 Then         Call Logger(groupLogName, "Error No Groups Found Quitting Script!", False)         Exit Sub     End If     objRecordSet.MoveFirst     Dim objGroup     Do Until objRecordSet.EOF         Call Logger(groupLogName, objRecordSet.Fields("ADsPath").Value & vbCrLf & "**********************************************", False)         Set objGroup = GetObject(objRecordSet.Fields("ADsPath").Value)         objGroup.Put "managedBy", groupManager         objGroup.SetInfo         If Err.Number <> 0 Then             Err.Clear             Call Logger(groupLogName, "Error Updating Manager to: " & groupManager, False)         Else             Call Logger(groupLogName, "Success Updating Manager to: " & groupManager, False)             If groupUpdateMembership = True Then                 'Allow Manager to Update Member List                 Call Logger(groupLogName, "Allow Manager to Update Member List: True", False)                 Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor")                 Set objDACL = objSecurityDescriptor.DiscretionaryACL                 Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy"))                 Set objACE = CreateObject("AccessControlEntry")                 objACE.Trustee = "snapretail\" & objUser.Get("sAMAccountName")                 objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP                 objACE.AceFlags = ADS_ACEFLAG_DONT_INHERIT_ACE                 objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT                 objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT                 objACE.objectType = ADS_OBJECT_WRITE_MEMBERS                 objDACL.AddAce(objACE)                 objSecurityDescriptor.DiscretionaryACL = objDACL                 objGroup.Put "ntSecurityDescriptor", Array(objSecurityDescriptor)                 objGroup.SetInfo                 If Err.Number <> 0 Then                     Err.Clear                     Call Logger(groupLogName, "Error Allowing Manager to Update Member List", False)                 Else                     Call Logger(groupLogName, "Success Allowing Manager to Update Member List", False)                 End If             End If         End If           Call Logger(groupLogName, "" & vbCrLf, False)           objRecordSet.MoveNext       Loop       On Error Goto 0   End Sub   Private Sub Logger(fileName, logMessage, blnNewLog)       On Error Resume Next       Const ForReading = 1, ForWriting = 2, ForAppending = 8     Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")     Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))     Dim logName     If InStr(1,fileName,"\",1) > 0 Then         logName = fileName         If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then             If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then                 If Not objFSO.FolderExists(logName) Then                     If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then                         objFSO.CreateFolder logName 'Create Folder In Current Path                        Exit Sub                     Else                         Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder                        Exit Sub                     End If                 End If             Else                 If Not objFSO.FileExists(logName) Then                     If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then                         Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder                    End If                 End If             End If         End If     Else         logName = scriptPath & fileName     End If     Dim logFile     If blnNewLog = True Then         Set logFile = objFSO.CreateTextFile(logName, True)     Else         If objFSO.FileExists(logName) Then             Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)         Else             Set logFile = objFSO.CreateTextFile(logName, True)         End If     End If     logFile.WriteLine logMessage     logFile.Close     Set objFSO = Nothing       On Error Goto 0   End Sub