User membership and description alphabetical export

Hi,

  I'm looking for a script that will recall user group membership and the group descriptions in alphabetical order, exported to a text file or word with the person's name.
The purpose is to be able to list access when using an account as a model by.

Name
Group descriptions
Group AD names

Thank you,

Anthony


Dim arrNames()
intSize = 0

On Error Resume Next
Const ForWriting = 2

UserName = InputBox("Enter Username","Enter Username")

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(UserName))
For Each strGroup in objUser.memberOf
    Set objGroup = GetObject("LDAP://" & strGroup)
    Report = Report & objGroup.CN & vbCrLf
    ReDim Preserve arrNames(intSize)
    arrNames(intSize) = objGroup.CN
    intSize = intSize + 1
Next
For Each strName in arrNames
For i = (UBound(arrNames) - 1) to 0 Step -1
    For j= 0 to i
        If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
            strHolder = arrNames(j+1)
            arrNames(j+1) = arrNames(j)
            arrNames(j) = strHolder
        End If
    Next
Next
Next

Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile (UserName & "GroupMembership.txt")

outFile.WriteLine
outFile.WriteLine "                       User Group Membership Report for " & UserName
outFile.WriteLine "                       ----------------------------"
outFile.WriteLine
outFile.WriteLine "Run on: " & Now()
For x = 0 to UBound(arrNames)
      arrUsers(x) = Trim(arrNames(x))
      If x = 0 Then
            outFile.WriteLine "Groups:" & arrNames(x)
      Else
            outFile.WriteLine "       " & arrNames(x)
      End If
Next
outFile.WriteLine "=================================================================="
outFile.WriteLine
For x = 0 to UBound(arrNames)
      Call getGroups(arrNames(x))
      'outFile.WriteLine "------------------------------------------------------------------"
ts.Write Report
Next

WScript.Echo "Done"


Public Function SearchDistinguishedName(ByVal vSAN)
    ' Function:     SearchDistinguishedName
    ' Description:  Searches the DistinguishedName for a given SamAccountName
    ' Parameters:   ByVal vSAN - The SamAccountName to search
    ' Returns:      The DistinguishedName Name
    Dim oRootDSE, oConnection, oCommand, oRecordSet

    Set oRootDSE = GetObject("LDAP://rootDSE")
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Open "Provider=ADsDSOObject;"
    Set oCommand = CreateObject("ADODB.Command")
    oCommand.ActiveConnection = oConnection
    oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
        ">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
    Set oRecordSet = oCommand.Execute
    On Error Resume Next
    SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
    On Error GoTo 0
    oConnection.Close
    Set oRecordSet = Nothing
    Set oCommand = Nothing
    Set oConnection = Nothing
    Set oRootDSE = Nothing
End Function