OBTENER DATOS A TRAVÉS DEL OBJETO WScript.Network Y OTRAS INFORMACIONES

Hola a todos!.

Recientemente recibí una consulta en la que un lector me preguntaba si le podía echar una mano  con una macro con la que deseaba extraer información de su equipo, en concreto necesitaba obtener el usuario de un equipo, el nombre del equipo, el nombre del dominio y la fecha y hora de la extracción de los datos.

Para poder conseguir los datos vamos a programar sobre el objeto WScript.Network, dado que sus propiedades (Username, UserDomain, ComputerName) nos van a permitir conocer los tres primeros datos.

De hecho, con esta simple macro obtendríamos la información:

Set sNetwork = CreateObject("WScript.Network")
nEqu = sNetwork.ComputerName
nDom = sNetwork.UserDomain
nUser = sNetwork.UserName

Efectivamente, creamos el objeto WScript.Networky a través de sus propiedades obtenemos la información que guaramos en tres variables.

Para obtener la fecha y la hora, podríamos usar la función Now en VBA, pero dado que estamos trabajando con scripts, lo haremos de la siguiente forma, con un objeto SWbemDateTime:

Set dtTime = CreateObject(«WbemScripting.SWbemDateTime»)
dtTime.SetVarDate (Now)
rDate = dtTime.GetVarDate

Y ya tendríamos los datos que el lector nos ha pedido. : )

El código completo sería así (con algunas cosas más que he añadido)

Sub INFORMACION_USUARIO()
'Declaramos variables
Dim sNetwork As Object, fSistem As Object, tSistem As Object, dir_Archivo As Object
Dim dtTime As Object, rDate As Date, i As Integer, MatrizInfo As Variant
Dim nEqu As String, nDom As String, nUser As String, Directorio As String
'Abrimos cuadro de dialogo para seleccionar carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Guardamos ruta a esta carpeta
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto Network para obtener las propiedades de usuario, equipo y dominio
Set sNetwork = CreateObject("WScript.Network")
nEqu = sNetwork.ComputerName
nDom = sNetwork.UserDomain
nUser = sNetwork.UserName
'obtenemos la fecha y hora del sistema
Set dtTime = CreateObject("WbemScripting.SWbemDateTime")
dtTime.SetVarDate (Now)
rDate = dtTime.GetVarDate
'Creamos objeto filesistem para crear TXT
Set fSistem = CreateObject("Scripting.FileSystemObject")
Set tSistem = fSistem.CreateTextFile(Directorio & "\INFORMACION.txt", True)
'Pasamos los datos al TXT
tSistem.WriteLine "Nombre del equipo:" & nEqu
tSistem.WriteLine "Nombre del dominio:" & nDom
tSistem.WriteLine "Nombre del usuario:" & nUser
tSistem.WriteLine "Fecha y hora:" & rDate
'También pasamos los datos a la hoja
MatrizInfo = Array(nEqu, nDom, nUser, rDate)
For i = LBound(MatrizInfo) To UBound(MatrizInfo)
Sheets(1).Cells(i + 1, 1) = MatrizInfo(i)
Next i
'Vaciamos variable de objeto
Set sNetwork = Nothing
Set fSistem = Nothing
Set tSistem = Nothing
Set dir_Archivo = Nothing
Set dtTime = Nothing
End Sub

Me ha parecido interesante incluir un cuadro de diálogo para seleccionar un directorio en el que vamos a guardar en un TXT los datos extraídos:

El cuadro de diálogo y la extracción del directorio lo hacemos así:

Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Guardamos ruta a esta carpeta
Directorio = dir_Archivo.SelectedItems(1)

y para crear el TXT y pasar los datos, usaremos el objeto FileSystemObject:

'Creamos objeto filesistem para crear TXT
Set fSistem = CreateObject("Scripting.FileSystemObject")
Set tSistem = fSistem.CreateTextFile(Directorio & "\INFORMACION.txt", True)
'Pasamos los datos al TXT
tSistem.WriteLine "Nombre del equipo:" & nEqu
tSistem.WriteLine "Nombre del dominio:" & nDom
tSistem.WriteLine "Nombre del usuario:" & nUser
tSistem.WriteLine "Fecha y hora:" & rDate

Una vez seleccionada la carpeta la macro creará el TXT (INFORMACION) y pasará la info, en mi caso la información es muy repetitiva, dado que siempre es la misma:

Por último, he añadido los resultados en una matriz que luego pasamos a un loop para mostrar la información en la primera hoja de nuestro archivo, en la columna A:

MatrizInfo = Array(nEqu, nDom, nUser, rDate)
For i = LBound(MatrizInfo) To UBound(MatrizInfo)
Sheets(1).Cells(i + 1, 1) = MatrizInfo(i)
Next i

Y se mostraría así:

Aunque he incluido algunas cosas que el lector no pedía, creo que siempre es bueno incorporar herramientas nuevas o diferentes, de un modo o de otro, siempre nos podrían servir para otros proyectos.

Espero que os haya resultado de interés y os pueda ser de utilidad.

Descarga el archivo de ejemplo pulsando en:  OBTENER DATOS A TRAVES DEL OBJETO WScript.Network Y OTRAS INFORMACIONES

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!