Script to set size limit in AD in vbs

May 17, 2008 12:12pm pdt

1. RobSampson 669,955
2. rorya 138,587
3. sungenwang 127,427
4. weellio 98,610
5. merowinger 93,100
6. zorvek 86,325
7. saurabh726 81,240
8. jeverist 57,096
9. Shift-3 45,870
10. sirbounty 44,935
11. chris_bo... 43,552
12. hielo 41,010
13. BlueDevi... 31,860
14. PaulHews 31,160
15. robberbaron 30,585

1. RobSampson 1,646,721
2. sirbounty 362,019
3. rorya 218,306
4. chandru_sol 182,049
5. zorvek 152,815
6. weellio 139,605
7. sungenwang 127,427
8. amit_g 108,710
9. merowinger 107,675
10. jeverist 107,296
11. Chris-Dent 105,637
12. BlueDevi... 95,210
13. matthews... 91,469
14. GrahamSkan 89,620
15. saurabh726 89,160

04.15.2008 at 12:13PM PDT, ID: 23324893 | Points: 400

	[x] Attachment Details

Script to set size limit in AD in vbs

Zone: VB Script

Hello to all experts,

Exp of Excel sheet: Cell1(MailboxDisplayname); Cell2(Current Mailboxsize of users); cell3(to set Quota maually prohibit send); cell4(to set Quota maually issue warning).

My goal:
-----------
First step has to read Cell1(MailboxDisplayname) and Cell2(Current Mailboxsize of users) and on the hand of current Mbx Size it has to set 100MB more for "warning" and 200MB more for "prohibit send" then the current MBX size.

2nd step is to set manually, after first step. a quota if needed.
3td sted create a list of new MBX quota that have been set to hhml file

In the scritp that I made there are several probelms.

Many thank in advance

         
           
             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:

           
           
             'My Code:
-----------
 
Option Explicit
On Error Resume Next
 
 
Dim strWarning, strStopSend
 
' get input
strDomainName = InputBox ("Enter Domain Name")
 
' *** CONNECT TO AD
Const ADS_PROPERTY_CLEAR = 1
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\UserLocator.xls")
objExcel.Visible = True
i = 2
 
Do Until objExcel.Cells(i, 1).Value = ""
	strUserName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)
 
	Set objDomain = GetObject("WinNT://" & strDomainName)
	objDomain.Filter = Array("User")
	blnFound = False
 
	For Each objUser in objDomain
		If objUser.Name = strUserName Then
			blnFound = True
			Exit For
		End If
	Next
 
	If blnFound = True Then
		strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
		strStopSend = Str(Int(objExcel.Cells(i,3) + 200000))
Else
		objExcel.Cells(i,2) = "FALSE"
	
	End If
	
	i = i + 1
Loop
 
   
'Close Objects
Set objADHelper = Nothing
Set objOU = Nothing
 
objConnection.Close
           
         

Start your free trial to view this solution

Question Stats

Zone: Programming

Question Asked By: jefmelkenbeek

Question Asked On: 04.15.2008

Participating Experts: 1

Points: 400

Translate:

Loading Advertisement...

Microsoft

Internet Protocols
Applications

Development
OS

Hardware
Windows Security

Apple

Operating Systems
Hardware

Programming
Networking

Software

Internet

Search Engines
File Sharing
WebTrends / Stats
Spy / Ad Blockers

Web Browsers
New Net Users
Web Development
Chat / IM

Anti Spam
Web Servers
Anti-Virus
Email Clients

Gamers

Tips
Online / MMORPG
Puzzle
Emulators

Action / Adventure
Role Playing
Consoles
Game Programming

Strategy
Sports
Misc
Computer Games

Digital Living

Hardware
New Net Users
New Users

Software
Digital Music
Gaming World

Home Security
Apple
Networking Hardware

Virus & Spyware

Vulnerabilities
IDS
Encryption
Anti-Virus

Operating Systems Security
Software Firewalls
WebApplications
Cell Phones

Operating Systems
Internet
Hardware Firewalls

Hardware

Handhelds / PDAs
Displays / Monitors
Components
Networking Hardware

Peripherals
Laptops/Notebooks
Storage
Servers

Desktops
New Users
Misc
Apple

Software

System Utilities
Industry Specific
Network Management
Photos / Graphics
Page Layout
VMWare
Misc
Web Development

OS
CYGWIN
Voice Recognition
Message Queue
Quality Assurance
Security
Firewalls
MultiMedia Applications

Development
Database
Office / Productivity
Business Management
OS/2 Apps
Server Software
Internet / Email

ITPro

OS
Storage
Encryption
Operating Systems Security
Apple Hardware
Laptops & Notebooks
Servers
Networking Hardware
Peripherals

Devices
Displays / Monitors
WebTrends / Stats
Search Engines
Firewalls
WebApplications
IDS
Vulnerabilities
Email Clients

File Sharing
Spy / Ad Blockers
Web Browsers
Web Servers
Networking
Anti-Virus
Chat / IM
Anti Spam

Developer

Web Servers
Web Browsers
Game Programming
Dev Tools
Industry Specific
Office / Productivity

Database
CYGWIN
Web Development
Search Engines
File Sharing
WebTrends / Stats

Programming
Content Management
Application Servers
Protocols

Storage

Removable Backup Media
Storage Technology
Servers

Grid
Remote Access
Backup / Restore

Misc
Hard Drives

Miscellaneous
Security
Development
Linux
VMWare

MainFrame OS
Unix
Apple
OS / 2
AS / 400

BeOS
Microsoft
VMS / OpenVMS

Database

Oracle
Miscellaneous
MySQL
Software
Sybase
Contact Management
PostgreSQL
Data Manipulation
Clarion
InterSystems Cache

Siebel
MUMPS
OLAP
SQLBase
SAS
GIS & GPS
4GL
Berkeley DB
DB2
Informix

Interbase / Firebird
FoxPro
Reporting
LDAP
Filemaker Pro
MS SQL Server
dBase
MS Access

Security

Misc
Web Browsers
Software Firewalls
Operating Systems Security
File Sharing

Spy / Ad Blockers
Vulnerabilities
WebApplications
IDS
Anti-Virus

Encryption
Anti Spam
Email Clients
VPN
Chat / IM

Programming

Editors IDEs
Installation
Handhelds / PDAs
Multimedia Programming
System / Kernel

Algorithms
Game
Signal Processing
Project Management
Open Source

Database
Misc
Languages
Processor Platforms
Theory

Web Development

Scripting
Blogs
Web Servers
Software
Search Engines
Web Graphics
Images

Internet Marketing
Images and Photos
Components
Document Imaging
Web Languages/Standards
Illustration
WebApplications

Fonts
WebTrends / Stats
Authoring
Digital Camera Software
Miscellaneous

Networking

Protocols
Apple Networking
Network Management
Message Queue
Application Servers
Content Management
File Servers
Email Servers
Misc
Java Editors & IDEs

Wireless
Networking Hardware
Backup / Restore
System Utilities
ISPs & Hosting
Web Servers
Storage Technology
Removable Backup Media
Servers
Broadband

Grid
OS / 2
Novell Netware
Unix Networking
Windows Networking
Security
Telecommunications
Operating Systems
Linux Networking

Other

Community Advisor
Lounge
Community Support
New Net Users

Philosophy / Religion
Math / Science
Miscellaneous
URLs

Expert Lounge
Politics
Puzzles / Riddles

Community Support

Suggestions
New to EE
New Topics
Community Advisor

CleanUp
Announcements
General

Feedback
Input
EE Bugs

04.16.2008 at 05:17PM PDT, ID: 21373124

Rank: Genius

RobSampson:

Hi, I don't see how your script reads the mailbox size at all...in the script below, change
strComputer = "."

to the name of your Exchange server, and try it. It will only give you sizes at the moment.

P.S. I don't use Exchange, so I can't test this at all.

Regards,

Rob.

                       
                          
                             
                             
                                strComputer = "."
 
' get input
strDomainName = InputBox ("Enter Domain Name")
 
' *** CONNECT TO AD
Const ADS_PROPERTY_CLEAR = 1
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Set objWorkbook = objExcel.Workbooks.Open("C:\UserLocator.xls")
objExcel.Visible = True
 
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & _
"\ROOT\MicrosoftExchangeV2")
 
For intRow = 2 To objWorkbook.Cells(65536, "A").End(xlUp).Row
	Set colItems = objWMIService.ExecQuery _
		("SELECT MailBoxDisplayName,Size FROM Exchange_Mailbox WHERE MailBoxDisplayName='" & objWorkbook.Cells(intRow, "A").Value & "'")
	
	If colItems.Count > 0 Then
		For Each objItem in colItems
			objOutputFile.Writeline objItem.MailboxDisplayName & "," & objItem.Size
		Next
	Else
		objExcel.Cells(intRow, "B") = "FALSE"
	End If
Next
 
Set objWMIService = Nothing
Set colItems = Nothing
 
MsgBox "Done"

                             
                          

                    

Open in New Window

04.16.2008 at 05:20PM PDT, ID: 21373134

Rank: Genius

RobSampson:

Oh, change
objOutputFile.Writeline objItem.MailboxDisplayName & "," & objItem.Size

to this
objExcel.Cells(intRow, "B").Value = objItem.Size

Regards,

Rob.

04.17.2008 at 05:03AM PDT, ID: 21376098

jefmelkenbeek:

hello RobSampson,

thanks for your response but the size is not what I'm looking for like your proposal. It has to set quota.

04.17.2008 at 07:10AM PDT, ID: 21377228

jefmelkenbeek:

After updating It doesn't give nothing as result even no errors.

Updated code with errors:
--------------------------------

Option Explicit
On Error Resume Next

Dim strWarning, strStopSend, strDNSDomain, objRootDSE, strServerName, strContainer

strServerName = "Servername"
strContainer = ", CN=test, dc=test, dc=net"

' get input
strDomainName = InputBox ("Enter Domain Name")

' *** CONNECT TO AD
'Active Directory (AD) Domain â¬ Binds To The Current Domain
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

Set RootDSE = GetObject("LDAP://rootDSE")
strDomainName = RootDSE.Get("DefaultNamingContext")

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\UserLocator.xls")
objExcel.Visible = True
i = 2

Do Until objExcel.Cells(i, 1).Value = ""

'strUserName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)

If objUser.Name = strUserName Then
strUserName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)

Set objDomain = GetObject("WinNT://" & strDomainName)
objDomain.Filter = Array("User")
blnFound = False

For Each objUser in objDomain
If objUser.Name = strUserName Then
blnFound = True
Exit For
End If

Next

If blnFound = True Then
strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
strStopSend = Str(Int(objExcel.Cells(i,3) + 200000))

strServerName = "servername"
                        strContainer = ", CN=test, dc=test, dc=net"


                  ' get the target mailbox
                  what = "LDAP://" & strServerName & "/CN=" & strUserName & strContainer
                  Set objMailbox = GetObject(what)

                  objMailbox.Put "mDBStorageQuota", strWarning
                  objMailbox.Put "mDBOverQuotaLimit", strStopSend
                  'objMailbox.Put "mDBOverHardQuotaLimit", prohibitSendReceiveLimit+10
                  objMailbox.SetInfo

            Else
objExcel.Cells(i,2) = "FALSE"

End If
End If
i = i + 1
Loop

'Close Objects

objConnection.Close

04.17.2008 at 05:21PM PDT, ID: 21382478

Rank: Genius

RobSampson:

Comment out On Error Resume Next. Initial errors you are having are that variables are undefined, and Option Explicit forces variables to be defined before you can use them.

I have included a few more variable declarations, so test this and see how it goes.

Regards,

Rob.

                       
                          
                             
                                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:

                             
                             
                                Option Explicit
'On Error Resume Next
 
 
Dim strWarning, strStopSend, strDNSDomain, objRootDSE, strServerName, strContainer, strDomainName
Dim objConnection, objCommand, RootDSE, objExcel, objWorkbook, blnFound
 
strServerName = "Servername"      
 strContainer = ",CN=test,dc=test,dc=net"
 
' get input
strDomainName = InputBox ("Enter Domain Name")
 
 
' *** CONNECT TO AD
'Active Directory (AD) Domain â¬ Binds To The Current Domain
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
 
Set RootDSE = GetObject("LDAP://rootDSE")
strDomainName = RootDSE.Get("DefaultNamingContext")
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\UserLocator.xls")
objExcel.Visible = True
i = 2
 
Do Until objExcel.Cells(i, 1).Value = ""
 
        'strUserName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)
            
            
            If objUser.Name = strUserName Then
               strUserName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)  
             
        Set objDomain = GetObject("WinNT://" & strDomainName)
        objDomain.Filter = Array("User")
        blnFound = False
 
        For Each objUser in objDomain
                If objUser.Name = strUserName Then
                        blnFound = True
                        Exit For
                End If
                
        Next
 
        If blnFound = True Then
                strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
                strStopSend = Str(Int(objExcel.Cells(i,3) + 200000))
                
                strServerName = "servername"      
                        strContainer = ", CN=test, dc=test, dc=net"
                        
                              
                  ' get the target mailbox
                  what = "LDAP://" & strServerName & "/CN=" & strUserName & strContainer
                  Set objMailbox = GetObject(what)
 
                  objMailbox.Put "mDBStorageQuota", strWarning
                  objMailbox.Put "mDBOverQuotaLimit", strStopSend
                  'objMailbox.Put "mDBOverHardQuotaLimit", prohibitSendReceiveLimit+10
                  objMailbox.SetInfo
 
 
            Else
                objExcel.Cells(i,2) = "FALSE"
       
        End If
         End If
        i = i + 1
Loop
 
  
'Close Objects
 
objConnection.Close 

                             
                          

                    

Open in New Window

04.17.2008 at 06:37PM PDT, ID: 21382716

jefmelkenbeek:

Hello Rob,

I'm totaly not a guru. I made mistake during question creation :-(.
I have still an error: (36, 1) Microsoft VBScript runtime error: Variable is undefined: 'i'
Can we also change to strusername to nickname?
regards,
Jef

04.17.2008 at 06:44PM PDT, ID: 21382734

Rank: Genius

RobSampson:

LOL! Nevermind the rating.....doesn't matter....we're here to help regardless.

For any time you get variable undefined errors when you have Option Explicit on, two things could be wrong. 1) the variable you are trying to use is a mis-spelled version of an already defined variable or 2) the variable is not defined yet. Define the variable using a Dim statement.

Try this.

Regards,

Rob.

                       
                          
                             
                                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:

                             
                             
                                Option Explicit
'On Error Resume Next
 
 
Dim strWarning, strStopSend, strDNSDomain, objRootDSE, strServerName, strContainer, strDomainName
Dim objConnection, objCommand, RootDSE, objExcel, objWorkbook, blnFound, i
 
strServerName = "Servername"      
 strContainer = ",CN=test,dc=test,dc=net"
 
' get input
strDomainName = InputBox ("Enter Domain Name")
 
 
' *** CONNECT TO AD
'Active Directory (AD) Domain â¬ Binds To The Current Domain
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
 
Set RootDSE = GetObject("LDAP://rootDSE")
strDomainName = RootDSE.Get("DefaultNamingContext")
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\UserLocator.xls")
objExcel.Visible = True
i = 2
 
Do Until objExcel.Cells(i, 1).Value = ""
 
        'nickName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)
            
            
            If objUser.Name = nickName Then
               nickName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)  
             
        Set objDomain = GetObject("WinNT://" & strDomainName)
        objDomain.Filter = Array("User")
        blnFound = False
 
        For Each objUser in objDomain
                If objUser.Name = nickName Then
                        blnFound = True
                        Exit For
                End If
                
        Next
 
        If blnFound = True Then
                strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
                strStopSend = Str(Int(objExcel.Cells(i,3) + 200000))
                
                strServerName = "servername"      
                        strContainer = ", CN=test, dc=test, dc=net"
                        
                              
                  ' get the target mailbox
                  what = "LDAP://" & strServerName & "/CN=" & nickName & strContainer
                  Set objMailbox = GetObject(what)
 
                  objMailbox.Put "mDBStorageQuota", strWarning
                  objMailbox.Put "mDBOverQuotaLimit", strStopSend
                  'objMailbox.Put "mDBOverHardQuotaLimit", prohibitSendReceiveLimit+10
                  objMailbox.SetInfo
 
 
            Else
                objExcel.Cells(i,2) = "FALSE"
       
        End If
         End If
        i = i + 1
Loop
 
  
'Close Objects
 
objConnection.Close

                             
                          

                    

Open in New Window

04.17.2008 at 07:13PM PDT, ID: 21382846

jefmelkenbeek:

thanks again Rob :-), but it gives now another error:
(43, 13) Microsoft VBScript runtime error: Object required: ''. and it replace in first cell nickname with Mailboxdisplayname. In AD it does nothing.

04.17.2008 at 07:20PM PDT, ID: 21382868

Rank: Genius

RobSampson:

Try this.

Rob.

                       
                          
                             
                                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:

                             
                             
                                Option Explicit
'On Error Resume Next
 
 
Dim strWarning, strStopSend, strDNSDomain, objRootDSE, strServerName, strContainer, strDomainName
Dim objConnection, objCommand, RootDSE, objExcel, objWorkbook, blnFound, i
 
strServerName = "Servername"      
 strContainer = ",CN=test,dc=test,dc=net"
 
' get input
strDomainName = InputBox ("Enter Domain Name")
 
 
' *** CONNECT TO AD
'Active Directory (AD) Domain â¬ Binds To The Current Domain
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
 
Set RootDSE = GetObject("LDAP://rootDSE")
strDomainName = RootDSE.Get("DefaultNamingContext")
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\UserLocator.xls")
objExcel.Visible = True
i = 2
 
Set objDomain = GetObject("WinNT://" & strDomainName)
objDomain.Filter = Array("User")
 
Do Until objExcel.Cells(i, 1).Value = ""
            
		nickName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)  
             
        blnFound = False
 
        For Each objUser in objDomain
                If objUser.Name = nickName Then
                        blnFound = True
                        Exit For
                End If                
        Next
 
        If blnFound = True Then
                strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
                strStopSend = Str(Int(objExcel.Cells(i,3) + 200000))
                
                strServerName = "servername"      
                        strContainer = ", CN=test, dc=test, dc=net"
                        
                              
                  ' get the target mailbox
                  what = "LDAP://" & strServerName & "/CN=" & nickName & strContainer
                  Set objMailbox = GetObject(what)
 
                  objMailbox.Put "mDBStorageQuota", strWarning
                  objMailbox.Put "mDBOverQuotaLimit", strStopSend
                  'objMailbox.Put "mDBOverHardQuotaLimit", prohibitSendReceiveLimit+10
                  objMailbox.SetInfo
 
 
            Else
                objExcel.Cells(i,2) = "FALSE"
       
        End If
         End If
        i = i + 1
Loop
 
  
'Close Objects
 
objConnection.Close

                             
                          

                    

Open in New Window

04.17.2008 at 07:33PM PDT, ID: 21382913

jefmelkenbeek:

another error: (38, 1) (null): 0x80005000

04.17.2008 at 07:41PM PDT, ID: 21382947

Rank: Genius

RobSampson:

Ok, line 38 is this:
Set objDomain = GetObject("WinNT://" & strDomainName)

strDomainName is given by this
Set objDomain = GetObject("WinNT://" & strDomainName)

which would actually return DC=Domain,DC=name, which is invalid for a WinNT query.

What you need is
Set objNetwork = CreateObject("WScript.Network")
strWinNTDomain = objNetwork.UserDomain

Try this.

Regards,

Rob.

                       
                          
                             
                                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:

                             
                             
                                Option Explicit
'On Error Resume Next
 
 
Dim strWarning, strStopSend, strDNSDomain, objRootDSE, strServerName, strContainer, strWinNTDomain, strDomainName
Dim objConnection, objCommand, RootDSE, objExcel, objWorkbook, blnFound, i
 
strServerName = "Servername"      
 strContainer = ",CN=test,dc=test,dc=net"
 
' get input
Set objNetwork = CreateObject("WScript.Network")
strWinNTDomain = objNetwork.UserDomain
'strWinNTDomain = InputBox ("Enter Domain Name")
 
 
' *** CONNECT TO AD
'Active Directory (AD) Domain â¬ Binds To The Current Domain
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
 
Set RootDSE = GetObject("LDAP://rootDSE")
strDomainName = RootDSE.Get("DefaultNamingContext")
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
 
'**** Loop: READ EXCEL SHEET LINES ***
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\UserLocator.xls")
objExcel.Visible = True
i = 2
 
Set objDomain = GetObject("WinNT://" & strWinNTDomain)
objDomain.Filter = Array("User")
 
Do Until objExcel.Cells(i, 1).Value = ""
            
		nickName = objExcel.Cells(i,1) + ", SERVER=" + objExcel.Cells(i,2)  
             
        blnFound = False
 
        For Each objUser in objDomain
                If objUser.Name = nickName Then
                        blnFound = True
                        Exit For
                End If                
        Next
 
        If blnFound = True Then
                strWarning = Str(Int(objExcel.Cells(i,3) + 100000))
      