Please help with this vb script ?

Hi All-knowing ones !

Please could you help point out where I am going wrong ? My script is tasked with pulling out the list of users and groups who are authorised to send to a distribution list. As it is below, it only pulls out groups or dist-lists which are listed in the tab and NOT the users. How do I modify it to pull the users as well ?
----------------------------------------------------------------------------------------------------------------

Set objShell = CreateObject("Wscript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")

'*** Ask for username
strUser = Inputbox("Please enter the name of the Distribution List you wish to view.")

If strUser = "" then
      Msgbox "No UserID entered! Script will now exit."
      WScript.Quit
End If

'*** Declare variables and constants

Dim con
Dim rs
Dim Com
Dim objDataScript
Const DATA_FOLDER = "C:\Scripts"
Const DATA_SCRIPT = "C:\Scripts\AD Dist List Membership results.txt"
GetADUserDetails = 0


'*** Setup an ADO query to get the values from the target object.
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set Com = CreateObject("ADODB.Command")

'*** Open a Connection object.
con.Provider = "ADsDSOObject"
con.Open "Active Directory Provider"

'*** Create a command object on this connection.
Set Com.ActiveConnection = con

'*** Collect ADsPath, sAMAccountName and cn details for target object
Com.CommandText = "<LDAP://invicta.cantium.net>;(samAccountName=" & strUser & ");ADsPath,sAMAccountName,cn"

'*** Set the preferences for Search.
Com.Properties("Page Size") = 1000
Com.Properties("Timeout") = 30

'*** Execute the query.
Set rs = Com.Execute
If rs.RecordCount = 1 Then
      strPath = rs.Fields(0).Value '*** Store path to users account
Else
      GetADUserDetails = 1 '*** User not found
End If



If GetADUserDetails = 1 then
      Msgbox "Folder name entered not found in directory."
      WScript.Quit
Else       '*** User exists so continue
      If Not objFS.FolderExists(DATA_FOLDER) Then            '*** Check for folder existence, if not found then create
            Set objFolder = objFS.CreateFolder(DATA_FOLDER)
      End If
      
      If objFS.FileExists(DATA_SCRIPT) Then      '*** File exists so append information to it
            On Error Resume Next
            Set objDataScript = objFS.OpenTextFile(DATA_SCRIPT,8,True)
            objDataScript.WriteBlankLines (1)
            objDataScript.WriteLine "**********************************"
            objDataScript.WriteLine "*            " & strUser
            objDataScript.WriteLine "**********************************"
            Set objUser = GetObject(strPath)

            arrMemberOf = objUser.GetEx("dLMemSubmitPerms")
            For Each Group in arrMemberOf
          Set objGroup = GetObject("LDAP://" & Group)
                                          
          GroupCN = objGroup.CN
          objDataScript.WriteLine ""& GroupCN
                                                Next
            objDataScript.Close
            MsgBox "Finished!"
            
      Else
            Set objDataScript = objFS.CreateTextFile(DATA_SCRIPT,True)      '*** File does not exist so create and then write to it
            On Error Resume Next
            Set objDataScript = objFS.OpenTextFile(DATA_SCRIPT,True)
            objDataScript.WriteLine "**********************************"
            objDataScript.WriteLine "*            " & strUser
            objDataScript.WriteLine "**********************************"
            Set objUser = GetObject(strPath)

            arrMemberOf = objUser.GetEx("dLMemSubmitPerms")            '*** Get users group membership
            For Each Group in arrMemberOf                        '*** Loop through groups
          Set objGroup = GetObject("LDAP://" & Group)
                        
                  '*** Check group is dist type or universal sec group
          GroupCN = objGroup.CN                                    '*** Get group name
          objDataScript.WriteLine ""& GroupCN                  '*** Write group name
                  Next
            objDataScript.Close
            MsgBox "Finished!"                                          '*** Indicate completion of process
            
      End If
End If
------------------------------------------------------------------------------------------------------------------
The list I wish to extract is under the Exchange General tab, and is the list under the Message Rectrictions section. Do I need to modify the "dLMemSubmitPerms" object name ?

Many thanks

LVL 1
ISG_QueryAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, try adding this
                For Each objMember In objGroup.Members
                      objDataScript.WriteLine objMember.CN
                Next

Under the two instances of this line:
          objDataScript.WriteLine ""& GroupCN    

Regards,

Rob.
0
ISG_QueryAuthor Commented:
Hey Rob

Thanks for the suggestion. I tried it a few times, but it ends up pulling a whole lot of other names. I will try it once or twice more and see.

First impressions say it doesn't work as required.
0
RobSampsonCommented:
Well what that block should do, is pull the group members of each group out....is that what you were after?

Rob.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

ISG_QueryAuthor Commented:
Hey. No, what I'm looking to do, is pull a list of the people or groups, that are listed in the "Only from / From everyone except" field, on the "Exchange General" tab.

Basically I need to record who can (or can't) send to a dist list.

The script I pasted above in my question, only returns the names of groups, which are listed in this field, NOT individuals who are listed.

Thanks
0
ISG_QueryAuthor Commented:
Any other ideas, oh all-knowing ones ?
0
RobSampsonCommented:
Hi, sorry I missed your last post.  I don't have Exchange, so I can't test the properties, but there's lots of code here:
http://support.microsoft.com/kb/252459

And it looks like you might need to go through the following options:
"authOrig", "unauthOrig", "dlMemSubmitPerms", "dlMemRejectPerms"

to list more info.

Play with those properties and hopefully you can get what you're after.  On a side not, you don't need to duplicate the part where you write to the file.  See the revised code below, and try to plug in the other properties where your dlMemSubmitPerms is, following the article above.

Regards,

Rob.
Set objShell = CreateObject("Wscript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")

'*** Ask for username
strUser = Inputbox("Please enter the name of the Distribution List you wish to view.")

If strUser = "" then
      Msgbox "No UserID entered! Script will now exit."
      WScript.Quit
End If

'*** Declare variables and constants

Dim con
Dim rs
Dim Com
Dim objDataScript
Const DATA_FOLDER = "C:\Scripts"
Const DATA_SCRIPT = "C:\Scripts\AD Dist List Membership results.txt"
GetADUserDetails = 0


'*** Setup an ADO query to get the values from the target object.
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set Com = CreateObject("ADODB.Command")

'*** Open a Connection object.
con.Provider = "ADsDSOObject"
con.Open "Active Directory Provider" 

'*** Create a command object on this connection.
Set Com.ActiveConnection = con

'*** Collect ADsPath, sAMAccountName and cn details for target object
Com.CommandText = "<LDAP://invicta.cantium.net>;(samAccountName=" & strUser & ");ADsPath,sAMAccountName,cn"

'*** Set the preferences for Search.
Com.Properties("Page Size") = 1000
Com.Properties("Timeout") = 30 

'*** Execute the query.
Set rs = Com.Execute
If rs.RecordCount = 1 Then
	strPath = rs.Fields(0).Value '*** Store path to users account
Else
	GetADUserDetails = 1 '*** User not found
End If

If GetADUserDetails = 1 Then
	Msgbox "Folder name entered not found in directory."
	WScript.Quit
Else       '*** User exists so continue
	If Not objFS.FolderExists(DATA_FOLDER) Then            '*** Check for folder existence, if not found then create
		objFS.CreateFolder DATA_FOLDER
	End If

	If objFS.FileExists(DATA_SCRIPT) Then
		boolBlankLine = False
	Else
		boolBlankLine = True
	End If

	On Error Resume Next
	' This will open the file for appending, and create it if it doesn't exist
	Set objDataScript = objFS.OpenTextFile(DATA_SCRIPT,8,True)
	If boolBlankLine = True Then objDataScript.WriteBlankLines (1)
	objDataScript.WriteLine "**********************************"
	objDataScript.WriteLine "*            " & strUser
	objDataScript.WriteLine "**********************************"
	Set objUser = GetObject(strPath)
	arrMemberOf = objUser.GetEx("dLMemSubmitPerms")
	For Each Group in arrMemberOf
		Set objGroup = GetObject("LDAP://" & Group)
		GroupCN = objGroup.CN
		objDataScript.WriteLine ""& GroupCN
	Next
	objDataScript.Close
	MsgBox "Finished!"
            
End If

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ISG_QueryAuthor Commented:
Apologies all powerful ones - time ran away with me.

Your response was very helpful, thank you. I will put it into practise ASAP.
0
ISG_QueryAuthor Commented:
Many thanks for a great forum and superb expert knowledge !
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.