Get Users from a specific Group in Active Directory

This script prompts for Group name and export the details into Excel

Option Explicit
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
With objExcel
    .Visible = True
    .DisplayAlerts = False
    Dim objWorkBook : Set objWorkBook = .WorkBooks.Add
    Dim objSheet : Set objSheet = .Worksheets(1)
End With
Create_Excel_File()
Dim intRow : intRow = 2
Dim strGroup : strGroup = InputBox("Enter the Group Name")
On Error Resume Next
    Dim objGroup : Set objGroup = GetObject("LDAP://" & GetDN(strGroup))
if err.number <> 0 then
    Msgbox err.number & " : Error Occured during process." & vbcrlf & "The Group " & strGroup & " does not exist."
    err.Clear
End If
Enum_Members(objGroup)
Format_Excel_File()

Sub Create_Excel_File()
    With objSheet
        '.Name = "Data"
        .Cells(1, 1).Value = "UserName"
        .Cells(1, 2).Value = "First Name"
        .Cells(1, 3).Value = "Last Name"
        .Cells(1, 4).Value = "Title"
        .Cells(1, 5).Value = "Work Phone"
        .Cells(1, 6).Value = "Mobile Phone"
        .Cells(1, 7).Value = "Pager"
        .Cells(1, 8).Value = "Home Phone"
 .Cells(1, 9).Value = "Dept"
 .Cells(1, 10).Value = "City"
 .Cells(1, 11).Value = "Country"
 .Cells(1, 12).Value = "Date Created"
    End With
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
    With objRange
        .Font.Bold = True
        .Font.Name = "Arial"
        .Font.Size = 10
        .WrapText = False
        .HorizontalAlignment = -4108
        .Interior.ColorIndex = 37
        .Cells.RowHeight = 25       
    End With
End Sub
Sub Format_Excel_File()
    Const xlsEdgeBottom = 9
    Const xlsEdgeLeft = 7
    Const xlsEdgeRight = 10
    Const xlsEdgeTop = 8
    Const xlsInsideHorizontal = 12
    Const xlsInsideVertical = 11
    Const xlsContinuous = 1
    Const xlsAutomatic = -4105
    Const xlsMedium = -4138
    Dim objRange : Set objRange = objSheet.UsedRange
    objRange.Select
   
    objRange.Columns.AutoFit
    Dim arrBorders : arrBorders = Array(xlsEdgeLeft, xlsEdgeTop, xlsEdgeBottom, xlsEdgeRight, xlsInsideVertical, xlsInsideHorizontal)
    Dim intBorder
    For Each intBorder in arrBorders
        With objRange.Borders(intBorder)
            .LineStyle = xlsContinuous
            .Weight = xlsMedium
            .ColorIndex = xlsAutomatic
        End With
    Next
End Sub

Sub Enum_Members(group)
    Dim arrAttributes : arrAttributes = Array("samaccountName", "GivenName", "sn", "Title", "telephonenumber", "Mobile", "Pager", "homePhone", "department", "l", "co", "whencreated")
    Dim objItem
    For Each objItem in group.Members
        If objItem.Class = "user" Then
            Dim intColumn : intColumn = 1
            Dim objUser : Set objUser = GetObject(objItem.AdsPath)
            Dim strAttrib
            For Each strAttrib in arrAttributes
                On Error Resume Next
                objSheet.Cells(intRow, intColumn).Value = objItem.Get(strAttrib)
                On Error GoTo 0
                intColumn = intColumn + 1
            Next
        End If           
        intRow = intRow + 1
    Next
    For Each objItem in group.Members
        If objItem.Class = "group" Then
            Call Enum_Members(objItem)
        End If
    Next
End Sub
Function GetDN(samAccount)
On Error Resume Next
      If Not IsObject(objWSHNetwork) Then
        Dim objWSHNetwork : Set objWSHNetwork = WScript.CreateObject("WScript.Network")
      End If
      Dim NT : Set NT= CreateObject("NameTranslate")
      NT.Init 3, ""
      NT.Set 3, objWSHNetwork.UserDomain & "\" & samAccount
      GetDN = NT.Get(1)
if err.number <> 0 then
    Msgbox err.number & " : Error Occured during process." & vbcrlf & "The Group " & strGroup & " does not exist."
    err.Clear
End If
End Function