Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

script to list all users profiles in computers in the active directory

Posted on 2010-09-03
13
Medium Priority
?
1,244 Views
Last Modified: 2012-05-10
i need to collect this information from my client computers in active directory 2003 for example :

Computer Name           Profile
client1                         user1
                                  user2
                                  user3

-------------------------------

also i need the script to get the computers from a text file.and the output  in .csv file.

Thank You
0
Comment
Question by:lovemask
  • 5
  • 4
  • 4
13 Comments
 

Author Comment

by:lovemask
ID: 33601020
if its posible to know each profile size in mb in each computer that will be great.
thanks
0
 
LVL 4

Expert Comment

by:Amnonm
ID: 33601287
Here you go just copy to TXT file customize and later save as .VBS


Const adVarChar = 200
Const MaxCharacters = 255
Const ForReading = 1
Const ForWriting = 2
Const ADS_SCOPE_SUBTREE = 2
Const FOR_WRITING = 2

'************************ Create Server List ****************************

set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("Serverlist.txt") Then
	objFSO.DeleteFile("Serverlist.txt")
End IF
Set objFile = objFSO.CreateTextFile("Serverlist.txt", FOR_WRITING)
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" )
strADSPath = "LDAP://" & RootDse.get( "DefaultNamingContext" )
objCommand.CommandText = _
	    "Select Name, Location from '" & strADSPath &_
		"' Where objectClass='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    objFile.WriteLine objRecordSet.Fields("Name").Value
    objRecordSet.MoveNext
Loop



'***********************  Sort Server List  ******************************

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "ComputerName", adVarChar, MaxCharacters
DataList.Open

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("serverlist.txt", ForReading)

Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine
    DataList.AddNew
    DataList("ComputerName") = strLine
    DataList.Update
Loop

objFile.Close

DataList.Sort = "ComputerName"

DataList.MoveFirst
Do Until DataList.EOF
    strText = strText & DataList.Fields.Item("ComputerName") & vbCrLf
    DataList.MoveNext
Loop

Set objFile = objFSO.OpenTextFile("serverlist.txt", ForWriting)

objFile.WriteLine strText
objFile.Close

Open in new window

0
 
LVL 67

Expert Comment

by:sirbounty
ID: 33601293
This should get what you're after...change the first two lines as appropriate for your input/output...
Const ComputerList = "C:\Computers.txt"
Const Output = "C:\Output.csv"
Const hklm=&h80000002

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOut : Set objOut = objFSO.CreateTextFile(Output)
Dim objFile : Set objFile = objFSO.OpenTextFile(ComputerList)
arrPCs = Split(objFile.ReadAll, vbNewLine)

For Each pc in arrPCs
  strDefProfile = GetProfilePath (pc)
  wscript.echo pc & vbTab & strDefProfile
  Set objFolder = objFSO.GetFolder ("\\" & pc & "\" & Replace(strDefProfile, ":\", "$\") )
  On Error Resume Next
  For each fld in objFolder.SubFolders
    objOut.Writeline pc & "," & fld & "," & fld.Size
  Next
Next

objOut.Close

Function GetProfilePath (strPC)
  strRegKey =  "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\"
  Dim wmiReg : Set wmiReg =GetObject("winmgmts:\\" & strPC & "\root\default:stdregprov")
  iRet=wmiReg.GetStringValue(hklm, strRegKey, "ProfilesDirectory", strValue)
  If iRet=0 Then
    GetProfilePath = strValue & "\"
  End If
End Function

Open in new window

0
What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

 
LVL 67

Expert Comment

by:sirbounty
ID: 33601299
Oops - didn't refresh.  Sorry about that.
And apparently read it a bit differently...
0
 
LVL 4

Expert Comment

by:Amnonm
ID: 33601303
I've extracted this script from MS Tech Net you can find more in there
http://technet.microsoft.com/en-us/scriptcenter/default.aspx 
0
 
LVL 4

Expert Comment

by:Amnonm
ID: 33601313
About the conversion to CSV later you can find it here very short.
http://www.colinwoodhouse.co.uk/txt-csv.htm
0
 

Author Comment

by:lovemask
ID: 33602121
i am getting error in line 13 second script :

Set objFolder = objFSO.GetFolder ("\\" & pc & "\" & Replace(strDefProfile, ":\", "$\") )
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 33602705
What's the error?  If it's an access denied, you don't have admin permissions...
0
 
LVL 4

Expert Comment

by:Amnonm
ID: 33602984
Do you got the error using what script?
0
 

Author Comment

by:lovemask
ID: 33604621
the two scripts are working fine. thanks.. but i need 1 thing more which is:

for example if the client is down or unreachable .. i need the script to continue test the next client in the list ... ( On Error Resume next ). also if its possible to get the size of each profile.?


thank you
0
 
LVL 67

Accepted Solution

by:
sirbounty earned 2000 total points
ID: 33604731
You can just relocate that to the top of the script, and it should work...
It should already get the profile size.
Const ComputerList = "C:\Computers.txt"
Const Output = "C:\Output.csv"
Const hklm=&h80000002

On Error Resume Next

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOut : Set objOut = objFSO.CreateTextFile(Output)
Dim objFile : Set objFile = objFSO.OpenTextFile(ComputerList)
arrPCs = Split(objFile.ReadAll, vbNewLine)

For Each pc in arrPCs
  strDefProfile = GetProfilePath (pc)
  wscript.echo pc & vbTab & strDefProfile
  Set objFolder = objFSO.GetFolder ("\\" & pc & "\" & Replace(strDefProfile, ":\", "$\") )
  For each fld in objFolder.SubFolders
    objOut.Writeline pc & "," & fld & "," & fld.Size
  Next
Next

objOut.Close

Function GetProfilePath (strPC)
  strRegKey =  "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\"
  Dim wmiReg : Set wmiReg =GetObject("winmgmts:\\" & strPC & "\root\default:stdregprov")
  iRet=wmiReg.GetStringValue(hklm, strRegKey, "ProfilesDirectory", strValue)
  If iRet=0 Then
    GetProfilePath = strValue & "\"
  End If
End Function

Open in new window

0
 

Author Comment

by:lovemask
ID: 33604844
thank you.. its perfect
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 33605324
Happy to have helped - thanks for the grade. :^)
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Setting up a Microsoft WSUS update system is free relatively speaking if you have hard disk space and processor capacity.   However, WSUS can be a blessing and a curse. For example, there is nothing worse than approving updates and they just have…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question