Does a tool exist that can bulk export all users and group memberships in NT4 User Manager to a .csv file?

'\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\
'\\    Filter AD groups, select a AD group and make a list of its users
'\\    Frans Erich  16-02-06
'\\
'\\		 Sub :  CheckForUser and GetUserAccount taken from "ADuser" script from Ralph E Montgomery 
'\\		 Function :  SelectBox taken from script from T. Lavedas
'\\    
'\\    Script only works in a domain environment
'\\
'\\\\\\\\\\\\\\\\\\\\\\\
'On Error Resume Next
Dim objGroup, objUser, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, Ouser, fso
Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount
 
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
strRootDSE = objRootDSE.Get("defaultNamingContext")
strDomain = UCase(objNet.UserDomain)
strSearch = LCase(InputBox("Geef een optionele waarde op waarop u groepen wilt filteren."))
ListGroups( strDomain )
intOpt = 1
'input validation
sGroup = SelectBox("Selecteer een groep", aOpt)
If sGroup = "Selecteer een groep" Then
	strMessage ="U heeft geen keuze gemaakt uit één van de aangeboden groepen."
	Cancelled()
End If
	
' Change the value of variable "strFormat"  beneath to "Outlook" to generate a new mail containing all email addresses of the mebers in the BCC box.
strFormat = "Excel"
 
Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
if sgroup <> "Aborted" then
     if sgroup <> "Selecteer een groep" then
            if strFormat = "Excel" then
                 strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
                 strFile = strTemp & "\Ledenlijst " & sgroup & ".csv"
                Set fso = CreateObject("Scripting.FileSystemObject")
              If fso.FileExists(strFile) Then
               fso.DeleteFile(strFile)
              End If 
               Set txtFile = fso.CreateTextFile(strFile)
               i = 0
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()
               	   GetUserAccount(strDN)
               else
               	   strMail = "computer account"
               	   strDisplayDepartment = "computer account"
        	   end if
               txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
               Next
               txtfile.close
               Set txtfile = nothing
               Set fso = nothing
               strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
               If KeyExists(strKey) = True Then
                    strKeyValue = WshShell.RegRead(strKey)
                    rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,TRUE) 
               else
                    rval = WshShell.Run("notepad.exe" & " " & strFile,1,TRUE)               
               end if
          else
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()        	   
               	   GetUserAccount(strDN)
               end if
               strBCC = strBCC & strMail &"; " 
               Next
               Set oMailApp = CreateObject("Outlook.Application")
               Set olMailItm = oMailApp.CreateItem(olMailItem)
               olMailItm.BCC = strBCC
               olMailItm.Display
          end if
     end if 
end if
 
Sub CheckForUser()
     Set objConnection = CreateObject("ADODB.Connection")
     objConnection.Provider = ("ADsDSOObject")
     objConnection.Open
     Set objCommand = CreateObject("ADODB.Command")
     objCommand.ActiveConnection = objConnection
     objCommand.CommandText = _
     "<LDAP://" & strRootDSE & ">;(&(objectCategory=user)" & _
     "(samAccountName=" & strGetUserName & "));distinguishedName,sAMAccountName,name;subtree"
     Set objRecordSet = objCommand.Execute
     strDN = objRecordset.Fields("distinguishedName") 
     Set objectRecordSet = Nothing
     objConnection.close
     Set objConnection = Nothing
End Sub
 
Sub GetUserAccount(strDN)
    On Error Resume Next
    If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
    Set objUser = GetObject("LDAP://" & strDN & "")
    Set objAdS = GetObject("LDAP://" & strRootDSE & "")
 
    With objUser
        '.GetInfo
        strMail =        .Get("mail")
        strLogonName =   .Get("sAMAccountName")
        strUserMail =    .Get("mail")
        strDescription = .GetEx("description")
        strDepartment =  .GetEx("department")
 
        strDisplayDepartment=""
        For Each strValue in strDepartment
         strDisplayDepartment = strDisplayDepartment & strValue
        Next
    
        For Each strValue in strDescription
         strDisplayDescription = strDisplayDescription & strValue
        Next
  
    End With
    
End Sub
 
Sub ListGroups( strDomain )
    Set objComputer = GetObject("WinNT://" & strDomain )
    objComputer.Filter = Array( "Group" )
    For Each objGroup In objComputer
    gt = objGroup.groupType
    if (InStr(LCase(objGroup.Name),strSearch) and (gt = &h02)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h01)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h08))  then
         ReDim Preserve aOpt(intOpt+ 1)
          aOpt(intOpt) = objGroup.Name
          intOpt = intOpt + 1
     end if
    Next
    If intOpt = 0 then
    strMessage ="Uw zoekopdracht heeft geen resultaat opgeleverd."
	Cancelled()
	end if
End Sub
 
Function SelectBox(sTitle, aOptions)
  Dim oIE, s, item
  set oIE = CreateObject("InternetExplorer.Application")
  With oIE
    .FullScreen = True
    .ToolBar   = False : .RegisterAsDropTarget = False
    .StatusBar = False : .Navigate("about:blank")
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
    .width= 400 : .height=200
    With .document
      with .parentWindow.screen
        oIE.left = (.availWidth  - oIE.width ) \ 2
        oIE.top  = (.availheight - oIE.height) \ 2
      End With
      s = "<html><head><title>" & sTitle _
        & "</title></head><script language=vbs>bWait=true<" & "/script>" _
        & "<body bgColor=Silver><center>" _
	& "<b>" & sTitle & "<b><p>" _
        & "<select id=entries size=1 style='width:325px'>" _
        & "  <option selected>" & sTitle & "</option>"
      For each item in aOptions
        s = s & "  <option>" & item & "</option>"
      Next
      s = s & "  </select><p>" _
        & "<button id=but0 onclick='bWait=false'>OK</button>" _
        & "<br><br><span style=" & chr(34)& "font-size: 8pt" & chr(34)& "><A HREF=" & chr(34)& "mailto:scripting@erich.nu" & chr(34)& ">build by Frans Erich</A></span>" _
        & "</center></body></html>"
      .open
      .Write(s)
      .close
      Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
      With .body
        .scroll="no"
        .style.borderStyle = "outset"
        .style.borderWidth = "3px"
      End With
      .all.entries.focus
      oIE.Visible = True
      CreateObject("Wscript.Shell").AppActivate sTitle
      On Error Resume Next
      Do While .ParentWindow.bWait
        WScript.Sleep 100
        if oIE.Visible Then SelectBox = "Aborted"
        if Err.Number <> 0 Then Exit Function
      Loop
      On Error Goto 0
      With .ParentWindow.entries
        SelectBox = .options(.selectedIndex).text
      End With
    End With
    .Visible = False
  End With
End Function
 
 
Function KeyExists(sKeyPath)
     keyExists= false: if (sKeyPath="") then exit function
     on error resume next
     createobject("wscript.shell").regRead sKeyPath
     select case err
     case 0: keyExists= true
     case &h80070002: dim sErrMsg
     sErrMsg= replace(err.description, sKeyPath, "")
     err.clear
     createobject("wscript.shell").regRead "HKEY_ERROR\"
     keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
     case else: keyExists= false
     end select
     on error goto 0
End function
Sub Cancelled()
    strTitle = "Einde script"
    MsgBox strMessage,vbOkOnly,strTitle
    WScript.quit
End Sub 'Cancelled

                                              

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: