Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VB script to Export Users Accounts from AD to a spread sheet

Status
Not open for further replies.

TimITFO

MIS
Aug 6, 2008
31
0
0
US


Hi All,

I need a simple vbscript that can Export User Accounts from AD to a spread sheet. I need to send these accounts to our HQ home office. Any simple script out there??
 
Run this from a DC. Can be tweaked to post data to a spreadsheet instead of text file.

Code:
'==========================================================================
'
' NAME: ListUsers.vbs
'
' AUTHOR: Mark D. MacLachlan, The Spider's Parlor
' DATE  : 2/2/2006
'
' COMMENT: <comment>
'
'    THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
'    ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO
'    THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
'    PARTICULAR PURPOSE.
'
'    IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS 
'    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
'    DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
'    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
'    ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
'    OF THIS CODE OR INFORMATION.

'
'==========================================================================
On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
strComputer = "."
   Report = Report & vbCrLf  
   Report = Report & vbCrLf &  "=========================================="
   Report = Report & vbCrLf &  "Computer: " & strComputer
   Report = Report & vbCrLf &  "=========================================="

   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount",,48)

   For Each objItem In colItems
      Report = Report & vbCrLf &  "AccountType: " & objItem.AccountType
      Report = Report & vbCrLf &  "Caption: " & objItem.Caption
      Report = Report & vbCrLf &  "Description: " & objItem.Description
      Report = Report & vbCrLf &  "Disabled: " & objItem.Disabled
      Report = Report & vbCrLf &  "Domain: " & objItem.Domain
      Report = Report & vbCrLf &  "FullName: " & objItem.FullName
      Report = Report & vbCrLf &  "InstallDate: " & WMIDateStringToDate(objItem.InstallDate)
      Report = Report & vbCrLf &  "LocalAccount: " & objItem.LocalAccount
      Report = Report & vbCrLf &  "Lockout: " & objItem.Lockout
      Report = Report & vbCrLf &  "Name: " & objItem.Name
      Report = Report & vbCrLf &  "PasswordChangeable: " & objItem.PasswordChangeable
      Report = Report & vbCrLf &  "PasswordExpires: " & objItem.PasswordExpires
      Report = Report & vbCrLf &  "PasswordRequired: " & objItem.PasswordRequired
      Report = Report & vbCrLf &  "SID: " & objItem.SID
      Report = Report & vbCrLf &  "SIDType: " & objItem.SIDType
      Report = Report & vbCrLf &  "Status: " & objItem.Status
      Report = Report & vbCrLf 
   Next



Function WMIDateStringToDate(dtmDate)
Report = Report & vbCrLf &  dtm: 
	WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
	Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
	& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("Users.txt") Then
   objFSO.DeleteFile("Users.txt")
End If
Set TS = objFSO.CreateTextFile ("Users.txt", ForWriting)
TS.Write Report
Wscript.Echo  Report & vbCrLf & "Done"



I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 

How about that... instead of txt file
"Can be tweaked to post data to a spreadsheet"

Can teak the code to post to spreadsheet?
 
Try this...

Code:
On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
strComputer = "."

   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount",,48)

strFile = "C:\export.xls"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.Workbooks.Add

objExcel.Cells(1,1).Value = "List Users"
objExcel.Cells(2,1).Value = "Time: " & Now

objExcel.Cells(4,1).Value = "Account Type"
objExcel.Cells(4,2).Value = "Caption"
objExcel.Cells(4,3).Value = "Description"
objExcel.Cells(4,4).Value = "Disabled"
objExcel.Cells(4,5).Value = "Domain"
objExcel.Cells(4,6).Value = "FullName"
objExcel.Cells(4,7).Value = "InstallDate"
objExcel.Cells(4,7).Value = "LocalAccount"
objExcel.Cells(4,7).Value = "Lockout"
objExcel.Cells(4,7).Value = "Name"
objExcel.Cells(4,7).Value = "PasswordChangeable"
objExcel.Cells(4,7).Value = "PasswordExpires"
objExcel.Cells(4,7).Value = "PasswordRequired"
objExcel.Cells(4,7).Value = "SID"
objExcel.Cells(4,7).Value = "SIDType"
objExcel.Cells(4,7).Value = "Status"

x = 5
y = 1

   For Each objItem In colItems

      y1 = y

      objExcel.Cells(x,y1).Value = objItem.AccountType
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Caption
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Description
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Disabled
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Domain
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.FullName
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = WMIDateStringToDate(objItem.InstallDate)
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.LocalAccount
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Lockout
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Name
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.PasswordChangeable
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.PasswordExpires
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.PasswordRequired
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.SID
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.SIDType
      y1 = y1 + 1
      objExcel.Cells(x,y1).Value = objItem.Status

      x = x + 1 'go to the next Row
Next

objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.ActiveWorkbook
objWorkbook.SaveAs strFile
objWorkbook.Close
objExcel.Quit

Function WMIDateStringToDate(dtmDate)
Report = Report & vbCrLf &  dtm:
    WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
    Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
    & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

Wscript.Echo "Done"
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top