El Blog de Gualtrysoft

Windows 2000/2003/2008, Active Directory, VBScript, Hyper-V, PowerShell y todo aquello interesante a la hora de usar, configurar y administrar Windows Server. También tenemos longanizas…

Script VBScript Para Obtener Un Listado De Usuarios Y Todas Sus Direcciones De Correo De Exchange

Posted by urpiano en Jueves 12 \12\UTC febrero \12\UTC 2009

Este script vuelca en un fichero XML los datos de las cuentas de correo de Exchange de los usuarios del dominio en el que se lanza. El listado se basa en mirar el atributo del usuario proxyAddresses y en el listado se muestra por tipos de cuentas (SMTP,cc:Mail, Microsoft Mail, X400, X500 y Otros)

El listado que se obtiene es ideal para abrirlo con Excel, agregarle una columna de nueva cuenta de correo, rellenarla, guardarlo como fichero de Excel, o de valores separados por comas o tabuladores, y pasarlo como parámetro /FRemitentes en el script Script VBScript Para Enviar Correos De Aviso De Cambio De Dirección (disclaimer), publicado en este mismo blog anteriormente (de hecho, es la última entrada anterior a esta).

Sintaxis

cscript [//nologo] listar-cuentas-correo-usuarios.vbs /S:fichero_XML [/?]

Siendo

Etiqueta Dato ¿Requerido? Descripción
S fichero_XML
Ruta y nombre del fichero XML que se creará con el listado de los usuarios y sus cuentas de Exchange
?   No
Muestra la ayuda en línea.

Ejemplos:

– El script creará el fichero XML \\filemonsrv\listado\correo-agentes.xlm:

cscript //nologo listar-cuentas-correo-usuarios.vbs /S:\\filemonsrv\listado\correo-agentes.xlm

Este es el código del script

'*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
'*°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°*
'* listar-cuentas-correo-usuarios.vbs                                  *
'*                                                                     *
'* Este script vuelca en un fichero XML los datos de las cuentas de    *
'* correo de Exchange de los usuarios del dominio en el que se lanza.  *
'* El listado se basa en mirar el atributo del usuario proxyAddresses  *
'* y en el listado se muestra por tipos de cuentas (SMTP,cc:Mail,      *
'* Microsoft Mail, X400, X500 y Otros)                                 *
'*                                                                     *
'* Sintaxis                                                            *
'*                                                                     *
'* cscript [//nologo] listar-cuentas-correo-usuarios.vbs               *
'* /S:fichero_XML [/?]                                                 *
'*                                                                     *
'* Siendo                                                              *
'*                                                                     *
'* - /S: fichero_XML (Requerido):                                      *
'*         Ruta y nombre del fichero XML que se creará con el listado  *
'*         de los usuarios y sus cuentas de Exchange                   *
'*                                                                     *
'* - /?: ayuda (Opcional):                                             *
'*         Muestra la ayuda en línea                                   *
'*                                                                     *
'*                                                                     *
'* Ejemplos:                                                           *
'*                                                                     *
'* - El script creará el fichero XML                                   *
'* \\filemonsrv\listado\correo-agentes.xlm:                            *
'*                                                                     *
'* cscript //nologo listar-cuentas-correo-usuarios.vbs                 *
'* /S:\\filemonsrv\listado\correo-agentes.xlm                          *
'*                                                                     *
'*                                                                     *
'*                                                                     *
'*                                                                     *
'* © Fernando Reyes                                                    *
'* Febrero De 2009                                                     *
'*°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°*
'*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

'Exigimos la declaración de variables
Option Explicit

Dim ado_Comando      'As ADODB.Command
Dim ado_Conexion     'As ADODB.Connection
Dim ado_RS           'As ADODB.Recordset
Dim str_Dominio      'As String
Dim str_Filtro       'As String
Dim str_Atributos    'As String
Dim str_Consulta     'As String
Dim str_Nombre       'As String
Dim str_Apellidos    'As String
Dim str_Email        'As String
Dim str_DN           'As String
Dim str_Direcciones  'As String
Dim str_SAM          'As String
Dim str_Contenedor   'As String
Dim str_Estado       'As String
Dim str_Empresa      'As String
Dim str_Departamento 'As String
Dim str_Oficina      'As String

Dim str_Error        'As String
Dim int_Error        'As String
Dim str_Fichero      'As String
Dim str_Salida       'As String

Dim obj_FS           'As Scripting.FileSystemObject
Dim obj_TS           'As Scripting.TextStream



'Validando los argumentos y almacenando
'sus valores
If f_RevisarArgumentos( _
                       str_Error, _
                       int_Error) Then

    Call s_Ayuda(str_Error)
    WScript.Quit int_Error

End If

'Creamos los objetos ADO de comando y conexión
Set ado_Comando = CreateObject("ADODB.Command")
Set ado_Conexion = CreateObject("ADODB.Connection")

'Establecemos el proveedor AD y abrimos la conexión
ado_Conexion.Provider = "ADsDSOObject"
ado_Conexion.Open "Active Directory Provider"

'Establecemos la ´conexión como conexión activa del
'objeto comando
ado_Comando.ActiveConnection = ado_Conexion

'Montamos la parte del dominio de la cadena de consulta
str_Dominio = "<LDAP://" & f_DNDominio & ">"

'Montamos la parte de filtro de la cadena de consulta
str_Filtro = "(&(objectCategory=person)(objectClass=user))"

'Montamos la parte de atributos a devolver de la cadena
'consulta
str_Atributos = "sAMAccountName,givenName,sn,mail," & _
                "proxyAddresses,distinguishedName," & _
                "st,company,department,physicalDeliveryOfficeName"
                
'Montamos la cadena de consulta
str_Consulta = str_Dominio & ";" & str_Filtro & ";" & str_Atributos _
    & ";subtree"
    
'Establecemos la consulta como texto de comando del objeto
'comando
ado_Comando.CommandText = str_Consulta

'Paginamos la consulta para que así muestre todo, no
'se limite a 1000 resultados
ado_Comando.Properties("Page Size") = 100
ado_Comando.Properties("Timeout") = 60
ado_Comando.Properties("Cache Results") = False

'Abrimos el recordset con la consulta
Set ado_RS = ado_Comando.Execute

'Creamos un objeto FileSystemObject
Set obj_FS = CreateObject("Scripting.FileSystemObject")

'Creamos el fichero XML de salida; en caso de que exista, lo
'sobreescribiremos
Set obj_TS = obj_FS.CreateTextFile(str_Fichero, True)

'Montamos en la variable de salida el inicio del fichero XML con la
'definición de tipo, codificación y el DTD del XML
str_Salida = "<?xml version=""1.0"" encoding=""ISO-8859-1""?>" & _
             vbCrLf & _
             "<!DOCTYPE usuarios [" & vbCrLf & _
             "    <!ELEMENT usuarios          (usuario*)>" & vbCrLf & _
             "    <!ELEMENT usuario           (sAMAccountName?,nom" & _
                                               "bre?,apellidos?,em" & _
                                               "ail?,contenedor?,d" & _
                                               "istinguishedName?," & _
                                               "estado?,empresa?,d" & _
                                               "epartamento?,ofici" & _
                                               "na?,proxyAddresses" & _
                                               "?)>" & vbCrLf & _
             "    <!ELEMENT sAMAccountName    (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT nombre            (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT apellidos         (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT email             (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT contenedor        (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT distinguishedName (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT estado            (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT empresa           (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT departamento      (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT oficina           (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT proxyAddresses    (smtp?,x400?,x500?," & _
                                              "ms?,ccmail?,otros?" & _
                                              ")>" & vbCrLf & _
             "    <!ELEMENT smtp              (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT x400              (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT x500              (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT ms                (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT ccmail            (#PCDATA)>" & vbCrLf & _
             "    <!ELEMENT otros             (#PCDATA)>" & vbCrLf & _
             "]>" & vbCrLf & _
             "<usuarios>" & vbCrLf

'Escribimos el inicio del fichero XML
obj_TS.Write str_Salida

'Recorremos hasta el final el recordset
While Not ado_RS.EOF

    'Sólo nos interesan aquellos usuarios cuyo atributo de cuenta
    'de correo no esté vacío y aquellos usuarios que estén
    'habilitados
    If Len("" & ado_RS.Fields("mail").Value) > 0 _
    And f_UsuarioHabilitado( _
                     ado_RS.Fields("distinguishedName").Value) Then
    
        'Vaciamos las variables de atributos
        str_SAM = ""
        str_Nombre = ""
        str_Apellidos = ""
        str_Email = ""
        str_DN = ""
        str_Direcciones = ""
        str_Contenedor = ""
        str_Estado = ""
        str_Empresa = ""
        str_Departamento = ""
        str_Oficina = ""
        
        'Ponemos los valores de los atributos a las correspondientes
        'variables
        
        'Nombre de usuario de inicio de sesión Pre-Windows 2000
        str_SAM = "" & ado_RS.Fields("sAMAccountName").Value
        
        'Nombre propio del usuario
        str_Nombre = "" & ado_RS.Fields("givenName").Value
        
        'Apellidos del usuario
        str_Apellidos = "" & ado_RS.Fields("sn").Value
        
        'Dirección principal de correo
        str_Email = "" & ado_RS.Fields("mail").Value
        
        'Direcciones de coreeo
        str_Direcciones = ado_RS.Fields("proxyAddresses").Value
        
        'OU o contenedor en el que está la cuenta de usuario
        str_Contenedor = f_Contenedor( _
                        ado_RS.Fields("distinguishedName").Value)
                        
        'Nombre distinguido
        str_DN = "" & ado_RS.Fields("distinguishedName").Value
        
        'Estado o provincia
        str_Estado = ado_RS.Fields("st").Value
        
        'Empresa
        str_Empresa = ado_RS.Fields("company").Value
        
        'Departamento
        str_Departamento = ado_RS.Fields("department").Value
        
        'Oficina
        str_Oficina = ado_RS.Fields( _
                            "physicalDeliveryOfficeName").Value
    
        'Mostramos por pantalla los datos del usuario, como
        'valores separados por comas
        WScript.Echo str_SAM & vbTab & _
                     str_Nombre & vbTab & _
                     str_Apellidos & vbTab & _
                     str_Email & vbTab & _
                     """" & f_ArrayACadena( _
                                  ado_RS.Fields( _
                                        "proxyAddresses").Value, _
                                        Chr(254)) & """" & _
                                                vbTab & _
                     str_Contenedor & vbTab & _
                     str_DN
                 
        'Montamos la salida del XML correspondiente al usuario
        str_Salida = _
                     Space(2) & "<usuario>" & vbCrLf & _
                     Space(4) & "<sAMAccountName>" & _
                                    f_CaracteresXML(str_SAM) & _
                                "</sAMAccountName>" & vbCrLf & _
                     Space(4) & "<nombre>" & _
                                    f_CaracteresXML(str_Nombre) & _
                                "</nombre>" & vbCrLf & _
                     Space(4) & "<apellidos>" & _
                                    f_CaracteresXML(str_Apellidos) & _
                                "</apellidos>" & vbCrLf & _
                     Space(4) & "<email>" & _
                                    f_CaracteresXML(str_Email) & _
                                "</email>" & vbCrLf & _
                     Space(4) & "<contenedor>" & _
                                    f_CaracteresXML(str_Contenedor) & _
                                "</contenedor>" & vbCrLf
        str_Salida = str_Salida & _
                     Space(4) & "<distinguishedName>" & _
                                    f_CaracteresXML(str_DN) & _
                                "</distinguishedName>" & vbCrLf & _
                     Space(4) & "<estado>" & _
                                    f_CaracteresXML(str_Estado) & _
                                "</estado>" & vbCrLf & _
                     Space(4) & "<empresa>" & _
                                    f_CaracteresXML(str_Empresa) & _
                                "</empresa>" & vbCrLf & _
                     Space(4) & "<departamento>" & _
                                    f_CaracteresXML(str_Departamento) & _
                                "</departamento>" & vbCrLf & _
                     Space(4) & "<oficina>" & _
                                    f_CaracteresXML(str_Oficina) & _
                                "</oficina>" & vbCrLf & _
                     f_Direcciones(ado_RS.Fields(_
                                            "proxyAddresses").Value) & _
                     Space(2) & "</usuario>" & vbCrLf
                     
        'Escribimos los datos del usuario en el fichero XML
        obj_TS.Write str_Salida
        
        'Limpiamos la variable de salida
        str_Salida = ""
    
    End If
    
    'Nos movemos al siguiente registro
    ado_RS.MoveNext

Wend

'str_Salida = str_Salida & "</usuarios>"
'Montamos el final del fichero XML
str_Salida = "</usuarios>"

'Escribimos el final
obj_TS.Write str_Salida

'Cerramos el fichero XML, el recordset y la conexión
obj_TS.Close
ado_RS.Close
ado_Conexion.Close

'Limpieza de bullarenga :-)
Set ado_RS = Nothing
Set ado_Comando = Nothing
Set ado_Conexion = Nothing
Set obj_TS = Nothing
Set obj_FS = Nothing

Function f_DNDominio() 'As String
'***********************************************************************
'* Procedimiento: f_DNDominio                                          *
'* Tipo         : Función                                              *
'* Devolución   : Cadena                                               *
'* Fecha y Hora : 12/02/2009 11:52:40                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función devuelve el nombre distinguido del      *
'*                dominio desde el que se lanza el script              *
'***********************************************************************

    Dim objRDSE 'As RootDSE

    'Obtenemos el objeto RootDSE
    Set objRDSE = GetObject("LDAP://RootDSE")
    
    'La función devuelve el nombre distinguido del dominio desde el que
    'se ha obtenido el objeto RootDSE
    f_DNDominio = objRDSE.Get("defaultNamingContext")
    
    'Limpieza de culito :-)
    Set objRDSE = Nothing

End Function 'f_DNDominio

Function f_ArrayACadena(arr_Array, str_Separador)
'***********************************************************************
'* Procedimiento: f_ArrayACadena                                       *
'* Tipo         : Función                                              *
'* Devolución   : Cadena                                               *
'* Fecha y Hora : 12/02/2009 11:56:47                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función recibe un array y una cadena            *
'*                separadora y devuelve una cadena con los elementos   *
'*                del array separados por la cadena separadora. Si la  *
'*                cadena separadora viene vacía, se usará la coma      *
'*                somo separador                                       *
'***********************************************************************

    Dim int_Elemento 'As Integer
    
    'Si el parámetro de array viene vacío, la función no devuelve nada
    If IsEmpty(arr_Array) Then Exit Function
    If IsNull(arr_Array) Then Exit Function
    
    'Si el separador viene vacío, se usará la coma como separador
    If Len(Trim(str_Separador)) = 0 Then str_Separador = ","
    
    'Recorremos los elementos del array
    For int_Elemento = LBound(arr_Array) To UBound(arr_Array)
    
        'Añadimos a la devolución el elemento actual y el separador
        f_ArrayACadena = f_ArrayACadena & _
                         arr_Array(int_Elemento) & str_Separador
        
    Next
    
    'Si hay devolución, quitamos el último separador, pues sobra
    If Len(f_ArrayACadena) > 0 Then _
        f_ArrayACadena = _
                Left(f_ArrayACadena, _
                     Len(f_ArrayACadena) - Len(str_Separador))

End Function 'f_ArrayACadena

Function f_Contenedor(str_LDAP) 'As String
'***********************************************************************
'* Procedimiento: f_Contenedor                                         *
'* Tipo         : Función                                              *
'* Devolución   : Cadena                                               *
'* Fecha y Hora : 12/02/2009 12:04:25                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función recibe un nombre distinguido de un      *
'*                objeto y devuelve la ruta a su contenedor en         *
'*                formato DNS, omitiendo el nombre de dominio. Por     *
'*                ejemplo:                                             *
'*                                                                     *
'*                Recibe: "CN=Filemón                                  *
'*                Pi,OU=Agentes,OU=Agencia,DC=tia,DC=org"              *
'*                Devuelve: "Agencia/Agentes"                          *
'***********************************************************************

    Dim int_Elemento 'As Integer
    Dim arr_LDAP     'As StringArray
    Dim str_Temp     'As String
    
    'Quitamos la parte correspondiente al dominio del nombre
    'distinguido
    str_Temp = Replace(str_LDAP, "," & f_DNDominio,"",1,-1,1)
    
    'Como se puede presentar la coma dentro de una de las partes del
    'nombre distinguido (por ejemplo "CN=Pi, Filemón,...") y es la coma
    'el separador de los elementos en los nombres distinguidos, Active
    'Directory quita el significado a esas comas con un backslash. En
    'esta función nos basamos en la coma para poder separar las partes
    'del nombre distinguido, y por tanto tanto necesitamos que esa coma
    'no nos provoque la creación de dos elementos incompletos en lugar
    'de uno completo. Por ello sustituimos la cadena "\," (en el
    'ejemplo anterior Active Directory almacena "CN=Pi\, Filemón,...")
    'por un caracter no imprimible
    str_Temp = Replace(str_Temp,"\,",Chr(30))
    
    'Obtenemos el array con los elementos del nombre distinguido
    arr_LDAP = Split(str_Temp,",")
    
    'Recorremos los elementos omitiendo el primero, que es el RDN
    'del objeto
    For int_Elemento = (LBound(arr_LDAP)+1) To UBound(arr_LDAP)
    
        'Montamos en la devolución el nombre del elemento actual
        'y lo separamos con una barra de división de la devolución
        'montada en la vuelta anterior
        f_Contenedor = arr_LDAP(int_Elemento) & "/" & f_Contenedor
    
    Next
    
    'Vamos a limpiar los identificadores de tipo de nombre de la
    'devolución
    'Los correspondientes a los dominios
    f_Contenedor = Replace(f_Contenedor,"DC=","")
    
    'Los correspondientes a las OUs
    f_Contenedor = Replace(f_Contenedor,"OU=","")
    
    'Los correspondientes a otro tipo de contenedores
    f_Contenedor = Replace(f_Contenedor,"CN=","")
    
    'Ahora quitamos la barra de división que sobra al final
    f_Contenedor = Left(f_Contenedor,Len(f_Contenedor) - 1)
    
    'Y por último restauramos los dúos "\," que puedan haber
    f_Contenedor = Replace(f_Contenedor,Chr(30),"\,")
    
End Function 'f_Contenedor

Function f_Direcciones(arr_Array) 'As String
'***********************************************************************
'* Procedimiento: f_Direcciones                                        *
'* Tipo         : Función                                              *
'* Devolución   : Cadena                                               *
'* Fecha y Hora : 12/02/2009 12:19:35                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función un array que es el atributo de usuario  *
'*                proxyAddresses, y devuelve el código XML             *
'*                correspondiente a estas direcciones                  *
'***********************************************************************

    Dim int_Elemento   'As Integer
    Dim str_Devolucion 'As String
    Dim str_SMTP       'As String
    Dim str_x400       'As String
    Dim str_x500       'As String
    Dim str_MS         'As String
    Dim str_ccMail     'As String
    Dim str_Otros      'As String
    
    'Si el array viene vacío, la función no devuelve nada
    If IsEmpty(arr_Array) Then Exit Function
    If IsNull(arr_Array) Then Exit Function
    
    'Iniciamos la devoucición con el inicio del tag de consjunto de
    'direcciones
    str_Devolucion = Space(4) & "<proxyAddresses>" & vbCrLf
    
    'Recorremos los elementos del array
    For int_Elemento = LBound(arr_Array) To UBound(arr_Array)
    
        'Si el tipo de cuenta es SMTP
        If LCase(Left(arr_Array(int_Elemento),5)) = "smtp:" Then
        
            'Añadimos la cuenta a la cadena con las cuentas SMTP
            'separadas por punto y coma y sin el identificador
            'SMTP
            str_SMTP = str_SMTP & _
                       f_CaracteresXML( _
                              Right(arr_Array(int_Elemento), _
                              Len(arr_Array(int_Elemento)) - 5)) & _
                       ";"
            
        'Si la cuenta es de Microsoft Mail, añadimos la cuenta a
        'la cadena con las cuentas Microsoft Mail separadas por
        'el caracter "Þ", y sin el identificador de Microsoft
        'Mail
        ElseIf LCase(Left(arr_Array(int_Elemento),3)) = "ms:" Then
        
            str_MS = str_MS & "&quot;" & _
                       f_CaracteresXML( _
                              Right(arr_Array(int_Elemento), _
                              Len(arr_Array(int_Elemento)) - 3)) & _
                       "&quot;Þ"

        'Si la cuenta es de cc:Mail, añadimos la cuenta a la cadena
        'con las cuentas cc:Mail separadas por el caracter "Þ", y sin
        'el identificador de cc:Mail
        ElseIf LCase(Left(arr_Array(int_Elemento),7)) = "ccmail:" Then
        
            str_ccMail = str_ccMail & "&quot;" & _
                       f_CaracteresXML( _
                              Right(arr_Array(int_Elemento), _
                              Len(arr_Array(int_Elemento)) - 7)) & _
                       "&quot;Þ"
                            
        'Si la cuenta es de X400, añadimos la cuenta a la cadena con
        'las cuentas X400 separadas por el caracter "Þ", y sin el
        'identificador de X400
        ElseIf LCase(Left(arr_Array(int_Elemento),5)) = "x400:" Then
        
            str_x400 = str_x400 & "&quot;" & _
                       f_CaracteresXML( _
                              Right(arr_Array(int_Elemento), _
                              Len(arr_Array(int_Elemento)) - 7)) & _
                       "&quot;Þ"
                            
        'Si la cuenta es de X500, añadimos la cuenta a la cadena con
        'las cuentas X500 separadas por el caracter "Þ", y sin el
        'identificador de X500
        ElseIf LCase(Left(arr_Array(int_Elemento),5)) = "x500:" Then
        
            str_x500 = str_x500 & "&quot;" & _
                       f_CaracteresXML( _
                              Right(arr_Array(int_Elemento), _
                              Len(arr_Array(int_Elemento)) - 7)) & _
                       "&quot;;"
                            
        'Si la cuenta es de cualuier otro tipo, añadimos la cuenta
        'a la cadena con las cuentas de otro tipo separadas por el
        'caracter "Þ" y conservando el identificador.
        ElseIf Len(Trim(arr_Array(int_Elemento))) > 0 Then
        
            str_Otros = str_Otros & "&quot;" & _
                       f_CaracteresXML(arr_Array(int_Elemento)) & _
                       "&quot;Þ"
                            
        End If
        
    Next
    
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'SMTP
    If Len(Trim(str_SMTP)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<smtp>" & _
                             Left(str_SMTP,Len(str_SMTP) - 1) & _
                             "</smtp>" & vbCrLf
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'X400
    If Len(Trim(str_x400)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<x400>" & _
                             Left(str_x400,Len(str_x400) - 1) & _
                             "</x400>" & vbCrLf
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'X500
    If Len(Trim(str_x500)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<x500>" & _
                             Left(str_x500,Len(str_x500) - 1) & _
                             "</x500>" & vbCrLf
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'Microsoft Mail
    If Len(Trim(str_MS)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<ms>" & _
                             Left(str_MS,Len(str_MS) - 1) & _
                             "</ms>" & vbCrLf
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'cc:Mail
    If Len(Trim(str_ccMail)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<ccmail>" & _
                             Left(str_ccMail,Len(str_ccMail) - 1) & _
                             "</ccmail>" & vbCrLf
    'Quitamos el último separador, pues sobra, y montamos
    'en la devolución la parte correspondiente a las cuentas
    'de cualquier otro tipo
    If Len(Trim(str_Otros)) > 0 Then _
            str_Devolucion = str_Devolucion & _
                             Space(6) & "<otros>" & _
                             Left(str_Otros,Len(str_Otros) - 1) & _
                             "</otros>" & vbCrLf
                                    
    'Si se han encontrado cuentas
    If Len(str_Devolucion) > Len(Space(4) & _
                                "<proxyAddresses>" & vbCrLf) Then
    
        'Cerramos el tag de lista de direcciones
        str_Devolucion = str_Devolucion & _
                         Space(4) & "</proxyAddresses>" & vbCrLf
                         
    Else
    
        'Como no se han encontrado direcciones, la devolución
        'será vacía
        str_Devolucion = ""
        
    End If
    
    'Efectuamos la devolución
    f_Direcciones = str_Devolucion

End Function 'f_Direcciones

Function f_CaracteresXML(str_Texto) 'As String
'***********************************************************************
'* Procedimiento: f_CaracteresXML                                      *
'* Tipo         : Función                                              *
'* Devolución   : Cadena                                               *
'* Fecha y Hora : 12/02/2009 12:39:57                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función recibe un texto y devuelve el mismo     *
'*                texto cambiando los caracteres reservados de XML     *
'*                por sus correspondientes códigos HTML                *
'***********************************************************************

    Dim str_Devolucion 'As String
    
    'Si el texto está vacío, la devolución es una cadena vacía
    If Len(Trim(str_Texto)) = 0 _
    Or IsNull(str_Texto) Then
    
        f_CaracteresXML = ""
        Exit Function
        
    End If
    
    'Iniciamos la devolución con el texto recibido
    str_Devolucion = str_Texto
    
    'Cambiamos los caracteres reservados de XML por sus códigos de
    'HTML
    str_Devolucion = Replace(str_Devolucion,"<","&lt;")
    str_Devolucion = Replace(str_Devolucion,">","&gt;")
    str_Devolucion = Replace(str_Devolucion,"&","&amp;")
    str_Devolucion = Replace(str_Devolucion,"'","&apos;")
    str_Devolucion = Replace(str_Devolucion,"""","&quot;")
    
    'Devolvemos el resultado
    f_CaracteresXML = str_Devolucion
    
End Function 'f_CaracteresXML

Function f_UsuarioHabilitado(str_DN)
'***********************************************************************
'* Procedimiento: f_UsuarioHabilitado                                  *
'* Tipo         : Función                                              *
'* Devolución   : Booleana                                             *
'* Fecha y Hora : 12/02/2009 12:44:55                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función recibe un nombre distinguido de         *
'*                usuario y devuelve True si la cuenta estña           *
'*                habilitada o False si está deshabilitada             *
'***********************************************************************

    Dim obj_Usuario 'As iADsUser

    'Establecemos control de errores
    On Error Resume Next
    
    'Obtenemos el objeto iADsUser del usuario, evitando el error que se
    'produce si contiene una barra de dividir y ésta no tiene su
    'correspondiente slash inverso para quitarle significado
    Set obj_Usuario = GetObject("LDAP://" & f_Slash(str_DN))
     
    'En ekl caso de que se haya producido error
    If Err.Number <> 0 Then
    
        'Se muestra el error en una ventana de mensaje
        MsgBox("Error " & Err.Number & " (" & _
        Err.Description & "). distinguishedName = """ & str_DN & """")  
        
        'Se termina el script devolviendo el número de error
        WScript.Quit Err.Number
        
    Else
    
        'Si hemos podido obtener el usuario, la devolución será la
        'negación de la propiedad AccountDisabled
        f_UsuarioHabilitado = Not(obj_Usuario.AccountDisabled)
        
    End If
    
    'Limpieza de parte posterior saliente :-)
    Set obj_Usuario = Nothing
    
End Function 'f_UsuarioHabilitado

Function f_Slash(str_DN)
'***********************************************************************
'* Procedimiento: f_Slash                                              *
'* Tipo         : Función                                              *
'* Devolución   : Booleana                                             *
'* Fecha y Hora : 12/02/2009 12:56:09                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función recibe un nombre distinguido y          *
'*                devuelve el mismo nombre, sólo que colocando un      *
'*                backslash delante de toda barra de división que      *
'*                encuentre que no lo tuviera ya. Esto sirve para      *
'*                evitar que se produzca error al intentar acceder al  *
'*                objeto. Por ejemplo:                                 *
'*                                                                     *
'*                Recibe: "CN=Bacterio /                               *
'*                Laboratorio,OU=Agencia,DC=tia,DC=org"                *
'*                Devuelve: "CN=Bacterio \/                            *
'*                Laboratorio,OU=Agencia,DC=tia,DC=org"                *
'***********************************************************************

    'Reemplazamos por un caracter no imprimible las barras de división
    'que sí están precedidas por un backslash
    f_Slash =Replace(str_DN,"\/",Chr(30))
    
    'Reemplazamos por el mismo caracter no imprimible las barras de
    'división que queden
    f_Slash = Replace(f_Slash,"/",Chr(30))
    
    'Reemplazamos los caracters no imprimibles que pusimos por el dúo
    'de backslash y barra de división
    f_Slash = Replace(f_Slash,Chr(30),"\/")

End Function 'f_Slash

Function f_RevisarArgumentos( _
                             str_Error, _
                             int_Error _
                             ) 'As Boolean
'***********************************************************************
'* Procedimiento: f_RevisarArgumentos                                  *
'* Tipo         : Función                                              *
'* Devolución   : Booleana                                             *
'* Fecha y Hora : 12/02/2009 10:58:43                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Esta función revisa los argumentos recibidos,        *
'*                recogiendo los posibles fallos por falta de          *
'*                argumentos requeridos y almacenando en las           *
'*                variables correspondientes los argumentos            *
'*                recibidos. recibe dos parámetros cuyo fin es ser de  *
'*                salida: una cadena que almacenará los errores        *
'*                detectados y un entero que almacenará el código de   *
'*                los errores detectados. Hay tres tipos de error;     *
'*                error 1 para los argumentos sin nombre requeridos y  *
'*                no encontrados, error 2 para los argumentos con      *
'*                nombre requeridos y no encontrados, por último,      *
'*                error 4 para los combos de argumentos opcionales     *
'*                (un combo de argumentos opcionales es aquel          *
'*                conjunto de argumentos opcionales que es requerido   *
'*                que se pase al menos uno de ellos y que si se pasa   *
'*                más de uno se ignorarán aquellos que estén detrás    *
'*                en la prioridad entre ellos; una característica      *
'*                clara de lo que es un combo de argumentos es cuando  *
'*                dos omás argumentos almacenan su valor en la misma   *
'*                variable). En el caso de producirse más de un tipo   *
'*                de error, el número de error será la suma de ambos   *
'*                de los errores recibidos, es decir 3, 5 o 6          *
'***********************************************************************

    Dim bol_Devolucion 'As Boolean
    Dim bol_Error1 'As Boolean
    Dim bol_Error2 'As Boolean
    Dim bol_Error4 'As Boolean

    'Iniciamos los indicadores
    bol_Devolucion = False
    bol_Error1 = False
    bol_Error2 = False
    bol_Error4 = False


    'Si hay que mostrar la ayuda, se muestra y
    'termina el script
    If WScript.Arguments.Named.Exists("?") Then

        Call s_Ayuda("******************" & vbCrLf & _
                     "*     AYUDA      *" & vbCrLf & _
                     "******************")

        WScript.Quit 0

    End If

    'Revisamos que esté el argumento requerido 
    '/S (fichero_XML)
    If WScript.Arguments.Named.Exists("S") Then

        str_Fichero =  _
               WScript.Arguments.Named("S")

    Else

        str_Error = str_Error & vbcrlf & _
                    "Error 2, falta argumento " & _
                    "requerido con nombre: " & _
                    "/S (fichero_XML)" & vbCrLf
        bol_Error2 = True

    End If

    'Preparamos las variables de devolucion:
    'el entero como suma de los posibles errores 1, 2 y 4
    int_Error = Abs(bol_Error1) + _
                (2 * Abs(bol_Error2)) + _
                (4 * Abs(bol_Error4))
    'La devolucion de la función será True en caso de
    'haber alguno de los errores
    bol_Devolucion = (bol_Error1 Or bol_Error2 Or bol_Error4)

    'Hacemos la devolución de la función
    f_RevisarArgumentos = bol_Devolucion

End Function 'f_RevisarArgumentos

Sub s_Ayuda(str_Error)
'***********************************************************************
'* Procedimiento: s_Ayuda                                              *
'* Tipo         : Sub                                                  *
'* Devolución   :                                                      *
'* Fecha y Hora : 12/02/2009 10:58:43                                  *
'* Autor        : Fernando Reyes                                       *
'*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯*
'* Propósito    : Este procedimiento muestra la ayuda en línea.        *
'*                Recibe un parámetro de tipo cadena que si viene      *
'*                será mostrado antes de la línea; pensado para que    *
'*                se muestre un error que se haya detectado.           *
'***********************************************************************

    'Si hay que mostrar algún texto previo a la ayuda, lo hacemos
    If Len(str_Error) > 0 Then

        WScript.Echo str_Error & vbCrLf & vbCrLf

    End If

    'A continuación, mostramos la ayuda por pantalla
    WScript.Echo "Este script vuelca en un fichero XML los datos de" & _
                 " las cuentas de correo de"
    WScript.Echo "Exchange de los usuarios del dominio en el que se" & _
                 " lanza. El listado se basa en"
    WScript.Echo "mirar el atributo del usuario proxyAddresses y en" & _
                 " el listado se muestra por"
    WScript.Echo "tipos de cuentas (SMTP,cc:Mail, Microsoft Mail, X" & _
                 "400, X500 y Otros)"
    WScript.Echo ""
    WScript.Echo "Sintaxis"
    WScript.Echo ""
    WScript.Echo "cscript [//nologo] listar-cuentas-correo-usuarios" & _
                 ".vbs /S:fichero_XML [/?]"
    WScript.Echo ""
    WScript.Echo "Siendo"
    WScript.Echo ""
    WScript.Echo "- /S: fichero_XML (Requerido):"
    WScript.Echo "Ruta y nombre del fichero XML que se creará con e" & _
                 "l listado de"
    WScript.Echo "los usuarios y sus cuentas de Exchange"
    WScript.Echo ""
    WScript.Echo "- /?: ayuda (Opcional):"
    WScript.Echo "Muestra la ayuda en línea"
    WScript.Echo ""
    WScript.Echo ""
    WScript.Echo "Ejemplos:"
    WScript.Echo ""
    WScript.Echo "- El script creará el fichero XML \\filemonsrv\li" & _
                 "stado\correo-agentes.xlm:"
    WScript.Echo ""
    WScript.Echo "cscript //nologo listar-cuentas-correo-usuarios.vbs"
    WScript.Echo "/S:\\filemonsrv\listado\correo-agentes.xlm"
    WScript.Echo ""
    WScript.Echo ""
    WScript.Echo ""

End Sub 's_Ayuda

 

 

4 comentarios to “Script VBScript Para Obtener Un Listado De Usuarios Y Todas Sus Direcciones De Correo De Exchange”

  1. Paco said

    Hola, antetodo muchas gracias por este y otros scripts de tu blog, me parece muy interesante.

    Tengo un problemilla con este script: lo ejecuto en un dominio pero no muestra todos los usuarios. Sin embargo este script sí que me muestra todos los usuarios, aunque no el dato que me interesa claro (las direcciones de e-mail). He comparado algunos usuarios que salen con un script y con otro no y en principio no veo diferencia alguna entre sus atributos. ¿Sabes a qué puede deberse esto? ¿Qué tendría que añadir al script de estado de usuarios para que mostrara también los e-mails?

    Gracias de antemano, un saludo.

    • urpiano said

      Paco,

      Gracias por advertirme esto. He tenido un despiste con este script, pues no he paginado la consulta que se hace a Active Directory. Si no paginas la consulta, ésta se limitará a los 1000 primeros resultados. Ahora lo he modificado para que pagine y por tanto debería ya de mostrarte todos los usuarios.

  2. Marianella Bergessio said

    En realidad no entiendo bien este asunto.
    Yo tengo un blog en WordPress, “encuentro cristiano” como me pueden decir las direcciones de mail de mis usuarios? me enseñan a…?

    camaleonmoreno@hotmail.com

    saludos

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s

 
A %d blogueros les gusta esto: