asked on

VBScript to Export Email Aliases on to same line seperated by a space per account

Rookie here!!! First Post Ever!
I am trying to batch upload aliases into MXLgic Spam Filtering Service, but I need them in a certain format.
I currently have a vbscript that will export the email alias address (proxy addresses) into a text file each on a separate line,
EXAMPLE:
John_Smith@domain.com
JSmith@domain.com
SmithJ@domain.com
Sam_Jones@domain.com
SJones@domain.com
JonesS@domain.com

WHAT I NEED IS THIS:

"The format of each entry in the file must be as follows (do not include the curly braces):

{new_email@domain.com} {optional_alias_prefix} {optional_alias_prefix2}

where:

{new_email@domain.com} - The complete email address, including domain, of the user account to be added.
{optional_alias_prefix} - Optional prefix for the alias email address to be associated with the new user account. Only designate the prefix of the email address (for example, "myname" in "myname@exampledomain.com"). "

EXAMPLE:
John_Smith@domain.com JSmith SmithJ
Sam_Jones@domain.com SJones JonesS
so forth and so on...

Here is my orgional VBSCRIPT:
'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set Container=GetObject("LDAP://DC=subdomain,DC=domain,DC=net")
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
Sub EnumerateUsers(Cont)
Dim User
 
'Go through all Users and select them
For Each User In Cont
Select Case LCase(User.Class)
 
'If you find Users
Case "user"
  'Select all proxyAddresses
  Dim Alias
  If Not IsEmpty(User.proxyAddresses) Then
    'OutPutFile.Write User.DisplayName
    For Each Alias in User.proxyAddresses
  	If InStr(1,Alias,"smtp",1) > 0 Then
			
			OutPutFile.Writeline Replace(Alias,"smtp:","",1,1,1)
			'WScript.Echo User.DisplayName & vbTab & Replace(Alias,"smtp:","",1,1,1)
		End If
    'WScript.Echo Alias
  	Next
  End If
 
Case "organizationalunit" , "container"
  EnumerateUsers User
 
End Select
Next
End Sub
'*******************************************************

Open in new window

merowinger

ok i'n notr 100 sure if this works..but i would create one string and write them only one time per user into the file

Here is my orgional VBSCRIPT:
'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set Container=GetObject("LDAP://DC=subdomain,DC=domain,DC=net")
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
Sub EnumerateUsers(Cont)
Dim User
 
'Go through all Users and select them
For Each User In Cont
Select Case LCase(User.Class)
 
'If you find Users
Case "user"
  'Select all proxyAddresses
  Dim Alias
  If Not IsEmpty(User.proxyAddresses) Then
    'OutPutFile.Write User.DisplayName
    For Each Alias in User.proxyAddresses
  	If InStr(1,Alias,"smtp",1) > 0 Then
 
			currentalias = Replace(Alias,"smtp:","",1,1,1)
			tempstring = tempstring + currentalias &" "
 
			'WScript.Echo User.DisplayName & vbTab & Replace(Alias,"smtp:","",1,1,1)
		End If
    'WScript.Echo Alias
  	Next
	OutPutFile.Writeline tempstring 
  End If
 
Case "organizationalunit" , "container"
  EnumerateUsers User
 
End Select
Next
End Sub
'*******************************************************

Open in new window

tbrower

ASKER

Thanks for the reply merowinger, but this caused the output to look like this:

email1 email 2
email1 email 2 email3
email1 email2 email3 email4
email1 email2 email3 email4 email5

Plus I need to be able to truncate the @domain.com for the aliases addresses
NOTE: I am pulling this data out of Active Directory

merowinger

I've just found another script..this looks very good for you

Const ForWriting = 2
 
filePath = "C:\smtpaddresses.txt"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(filepath, ForWriting, True)
 
Set rootDSE = GetObject("LDAP://RootDSE")
DomainContainer = rootDSE.Get("defaultNamingContext")
 
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
 
'LDAP query for all mail users
strLDAP = "<LDAP://" & DomainContainer & ">;(&(mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree"
 
'Get query results and output to file
Set oComm = CreateObject("ADODB.Command")
oComm.ActiveConnection = conn
oComm.CommandText = strLDAP
oComm.Properties("Sort on") = "DisplayName"
oComm.Properties("Page size") = 1500
 
Set rs = oComm.Execute
 
While Not rs.EOF
	
	   Set FoundObject = GetObject (rs.Fields(0).Value)
		arrProxyAddresses = FoundObject.proxyAddresses
		For Each Address In arrProxyAddresses
			If left(Address,5)= "smtp:" Then
			 objTextFile.writeLine(FoundObject.Displayname & " " & Address)
			End if
		Next
    rs.MoveNext
Wend
 
MsgBox "Processing complete!"

Open in new window

tbrower

ASKER

The output of this script is very similiar to my origional post.
John Smith smtp:John_Smith@domain.com
John Smith smtp:JSmith@domain.com
John Smith smtp:SmithJ@domain.com
Sam Jones smtp:Sam_Jones@domain.com
Sam Jones smtp:SJones@domain.com
Sam Jones smtp:JonesS@domain.com

It needs to look like this:
John_Smith@domain.com[SPACE]JSmith[SPACE]SmithJ
Sam_Jones@domain.com[SPACE]SJones[SPACE]JonesS

merowinger

ok i hope this will do the job!


Const ForWriting = 2
yourdomain = "@domain.com"
bFirstEntryForUser = true 
filePath = "C:\smtpaddresses.txt"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(filepath, ForWriting, True)
 
Set rootDSE = GetObject("LDAP://RootDSE")
DomainContainer = rootDSE.Get("defaultNamingContext")
 
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
 
'LDAP query for all mail users
strLDAP = "<LDAP://" & DomainContainer & ">;(&(mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree"
 
'Get query results and output to file
Set oComm = CreateObject("ADODB.Command")
oComm.ActiveConnection = conn
oComm.CommandText = strLDAP
oComm.Properties("Sort on") = "DisplayName"
oComm.Properties("Page size") = 1500
 
Set rs = oComm.Execute
 
While Not rs.EOF
	
	Set FoundObject = GetObject (rs.Fields(0).Value)
		arrProxyAddresses = FoundObject.proxyAddresses
		For Each Address In arrProxyAddresses
			If left(Address,5)= "smtp:" Then
				If bFirstEntryForUser = true then
					tempstring = Replace(Address,"smtp:","") &" "
					bFirstEntryForUser = false
				Else
					temp1 = Replace(Address,"smtp:","")
					temp2 = Replace(temp1,yourdomain,"") 
					tempstring = tempstring + temp1 &" "
				End If
 
			End if
		Next
		bFirstEntryForUser = true
    	rs.MoveNext
Wend
 
objTextFile.writeLine tempstring 
MsgBox "Processing complete!"

Open in new window

tbrower

ASKER

This script only gave me 1 (one) entry similiar to this:
JSmith@domain.com:SmithJ@domain.com
(Missing the third address)
I have been playing with your first script you gave:
I changed the tempstring as decribe here: tempstring = currentalias &" " + tempstring
Output was CLOSE...
1emailA 1emailB 1emailC
2emailA 2emailB 2emailC 1emailA 1emailB 1emailC
3emailA 3emailB 3emailC 2emailA 2emailB 2emailC 1emailA 1emailB 1emailC

It comes out correct (minus the truncation of the domain) but the prior line is appended to the end.
Thanks agian for your help. I need to head home here in abit, i'll jump back on later tonight.

If InStr(1,Alias,"smtp",1) > 0 Then
 
                       currentalias = Replace(Alias,"smtp:","",1,1,1)
		tempstring = currentalias &" " + tempstring
 
	End If
      Next
      OutPutFile.Writeline tempstring

Open in new window

RobSampson

Hi, I don't have ProxyAddresses, so I can't test this, but try it out.

Regards,

Rob.

'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set objRootDSE = GetObject("LDAP://RootDSE")
Set Container=GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
Sub EnumerateUsers(Cont)
Dim User
 
'Go through all Users and select them
For Each User In Cont
Select Case LCase(User.Class)
 
'If you find Users
Case "user"
  'Select all proxyAddresses
  Dim Alias
  If Not IsEmpty(User.proxyAddresses) Then
    'OutPutFile.Write User.DisplayName
    strAliases = ""
    For Each Alias in User.proxyAddresses
  	If InStr(1,Alias,"smtp",1) > 0 Then
			strAddress = Replace(Alias,"smtp:","",1,1,1)
			arrAlias = Split(strAddress, "@")
			If strAliases = "" Then
				strAliases = strAddress
			Else
				strAliases = strAliases & " " & arrAlias(0)
			End If
			'WScript.Echo User.DisplayName & vbTab & Replace(Alias,"smtp:","",1,1,1)
		End If
    'WScript.Echo Alias
    OutPutFile.WriteLine strAliases
  	Next
  End If
 
Case "organizationalunit" , "container"
  EnumerateUsers User
 
End Select
Next
End Sub
'*******************************************************

Open in new window

tbrower

ASKER

Getting Closer!!!!
Her is actual output:

Dunhill_Allen@domain.com
Dunhill_Allen@domain.com
Dunhill_Allen@domain.com Allen_Dunhill
Dunhill_Allen@domain.com Allen_Dunhill
Dunhill_Allen@domain.com Allen_Dunhill Allan_Dunhill
Dunhill_Allen@domain.com Allen_Dunhill Allan_Dunhill adunhill
Dunhill_Allen@domain.comAllen_Dunhill Allan_Dunhill adunhill adunhill
Drasky_Brandie@domain.com
Drasky_Brandie@domain.com
Drasky_Brandie@domain.com Brandie_Drasky
Drasky_Brandie@domain.com Brandie_Drasky
Drasky_Brandie@domain.com Brandie_Drasky bdrasky
Drasky_Brandie@domain.com Brandie_Drasky bdrasky bdrasky
Drasky_Brandie@domain.comBrandie_Drasky bdrasky bdrasky bdrasky
Smith_Chad@domain.com
Smith_Chad@domain.com Chad_Smith
Smith_Chad@domain.comChad_Smith csmith
Smith_Chad@domain.com Chad_Smith csmith csmith
Smith_Chad@domain.com Chad_Smith csmith csmith csmith2
Smith_Chad@domain.com Chad_Smith csmith csmith csmith2

Definitely closer. i'll get back later.

RobSampson

oh DOH! The OutputFile.Writeline statement should be under the Next, not above it!

Also, I've noticed some duplicate prefixes...I'll fix that...

Regards,

Rob.

'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set objRootDSE = GetObject("LDAP://RootDSE")
Set Container=GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
Sub EnumerateUsers(Cont)
Dim User
 
'Go through all Users and select them
For Each User In Cont
Select Case LCase(User.Class)
 
'If you find Users
Case "user"
  'Select all proxyAddresses
  Dim Alias
  If Not IsEmpty(User.proxyAddresses) Then
    'OutPutFile.Write User.DisplayName
    strAliases = ""
    For Each Alias in User.proxyAddresses
  	If InStr(1,Alias,"smtp",1) > 0 Then
			strAddress = Replace(Alias,"smtp:","",1,1,1)
			arrAlias = Split(strAddress, "@")
			If InStr(LCase(strAliases), LCase(arrAlias(1)) = 0 Then
				If strAliases = "" Then
					strAliases = strAddress
				Else
					strAliases = strAliases & " " & arrAlias(0)
				End If
			End If
			'WScript.Echo User.DisplayName & vbTab & Replace(Alias,"smtp:","",1,1,1)
		End If
    'WScript.Echo Alias
  	Next
    OutPutFile.WriteLine strAliases
  End If
 
Case "organizationalunit" , "container"
  EnumerateUsers User
 
End Select
Next
End Sub
'*******************************************************

Open in new window

Paka

Try this - I also ran it through a source formatter to clean things up...

'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set objRootDSE = GetObject("LDAP://RootDSE")
Set Container = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
 
Sub EnumerateUsers(Cont)
    Dim User
    
    'Go through all Users and select them
    For Each User In Cont
        Select Case LCase(User.Class)
            
            'If you find Users
            Case "user"
                'Select all proxyAddresses
                Dim Alias
                If Not IsEmpty(User.proxyAddresses) Then
                    'OutPutFile.Write User.DisplayName
                    strAliases = ""
                    For Each Item in user.proxyAddresses
                        strTempAddr = Item
                        If InStr(UCase(Item), "SMTP:") <> 0 Then
                            If InStr(Item, "SMTP:") <> 0 Then
                                'move primary SMTP to beginning of list
                                smtpList = Item & " " & smtpList
                            Else
                                'clean SMTP from String
                                Item = Replace(Item, "smtp:", "")
                                
                                'clean the suffix from string
                                Item = Left(Item, InStr(Item, "@") -1)
                                
                                'append alternate SMTP to end of list
                                smtpList = smtpList & " " & Item
                            End If
                        End If
                        proxyCount = Count + 1
                    Next
                    OutPutFile.WriteLine smtpList
                End If
                
            Case "organizationalunit" , "container"
                EnumerateUsers User
                
        End Select
    Next
End Sub
 
'*******************************************************

Open in new window

Paka

Sorry, I forgot to initialize the smtpList variable. At line 42, change strAliases = "" to SMTPList = "".

Note: I added some code to move the primary SMTP to the begining of the list.

tbrower

ASKER

PAKA is really close!! The script's output looks perfect execept i need the "SMTP: " to be stripped off.
Rob Sampson's code got an error on this line of code " If InStr(LCase(strAliases), LCase(arrAlias(1)) = 0 Then " it is expecting another (

RobSampson

Hi, you are correct, mine was missing a closing bracket....try this.

Regards,

Rob.

'**************************************************
'Global variables
Dim Container
Dim OutPutFile
Dim FileSystem
 
'Initialize global variables
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("smtpaddresses.txt", True)
 
'Replace with valid DN of the container you want to enumerate
Set objRootDSE = GetObject("LDAP://RootDSE")
Set Container=GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
 
'Enumerate Container
EnumerateUsers Container
 
'Clean up
OutPutFile.Close
Set FileSystem = Nothing
Set Container = Nothing
 
'Say Finished when your done
WScript.Echo "Finished"
WScript.Quit(0)
 
'List all Users
Sub EnumerateUsers(Cont)
Dim User
 
'Go through all Users and select them
For Each User In Cont
Select Case LCase(User.Class)
 
'If you find Users
Case "user"
  'Select all proxyAddresses
  Dim Alias
  If Not IsEmpty(User.proxyAddresses) Then
    'OutPutFile.Write User.DisplayName
    strAliases = ""
    For Each Alias in User.proxyAddresses
  	If InStr(1,Alias,"smtp",1) > 0 Then
			strAddress = Replace(Alias,"smtp:","",1,1,1)
			arrAlias = Split(strAddress, "@")
			If InStr(LCase(strAliases), LCase(arrAlias(1))) = 0 Then
				If strAliases = "" Then
					strAliases = strAddress
				Else
					strAliases = strAliases & " " & arrAlias(0)
				End If
			End If
			'WScript.Echo User.DisplayName & vbTab & Replace(Alias,"smtp:","",1,1,1)
		End If
    'WScript.Echo Alias
  	Next
    OutPutFile.WriteLine strAliases
  End If
 
Case "organizationalunit" , "container"
  EnumerateUsers User
 
End Select
Next
End Sub
'*******************************************************

Open in new window

ASKER CERTIFIED SOLUTION

Paka

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

tbrower

ASKER

Thanks PAKA!!! It works like a charm. Thanks Again

jjr1204

Paka,

How can I list all the smtp addresses in single file below one another?