Script VBScript Para Obtener Un Listado De Usuarios Y Todas Sus Direcciones De Correo De Exchange
Publicado por urpiano en Jueves 12 de Febrero de 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 | Sí |
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 & """ & _
f_CaracteresXML( _
Right(arr_Array(int_Elemento), _
Len(arr_Array(int_Elemento)) - 3)) & _
""Þ"
'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 & """ & _
f_CaracteresXML( _
Right(arr_Array(int_Elemento), _
Len(arr_Array(int_Elemento)) - 7)) & _
""Þ"
'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 & """ & _
f_CaracteresXML( _
Right(arr_Array(int_Elemento), _
Len(arr_Array(int_Elemento)) - 7)) & _
""Þ"
'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 & """ & _
f_CaracteresXML( _
Right(arr_Array(int_Elemento), _
Len(arr_Array(int_Elemento)) - 7)) & _
"";"
'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 & """ & _
f_CaracteresXML(arr_Array(int_Elemento)) & _
""Þ"
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,"<","<")
str_Devolucion = Replace(str_Devolucion,">",">")
str_Devolucion = Replace(str_Devolucion,"&","&")
str_Devolucion = Replace(str_Devolucion,"'","'")
str_Devolucion = Replace(str_Devolucion,"""",""")
'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
Paco escribió
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 escribió
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.