¿Quién ha abierto mi libro de Excel?

Basado en la opción de confirmación de lectura que tiene Microsoft Outlook, te presento una pequeña herramienta que te permitirá averiguar tanto el usuario como el momento exacto en que se ha abierto un libro de Excel.

Atención: Antes de implementar este ejemplo debes saber que cada vez que un usuario abra el archivo, recibirás un correo electrónico de confirmación. Esto puede parecer algo inofensivo, pero si se hace una gran distribución y el archivo es abierto por cientos o miles de usuarios, recibirás otros tantos correos electrónicos, lo que puede ser agobiante.

La mayor parte del código que contiene el archivo que adjunto al pie del artículo se encuentra dentro del evento Open del libro. Además, he creado un módulo que contiene una pequeña función que extrae el nombre de usuario de Windows en caso de no tener configurado el remitente en Outlook.

Inserta el siguiente código en el módulo de libro:

Option Explicit

Private Sub Workbook_Open()
   Dim objOutlook As Outlook.Application
   Dim objOutlookMsg As Outlook.MailItem
   Dim objOutlookRecip As Outlook.Recipient
   Dim strUser As String
   Set objOutlook = CreateObject("Outlook.Application")
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   strUser = cptName
   If cptName = "" Then strUser = Application.UserName
   On Error Resume Next
   With objOutlookMsg
' La siguiente línea es la que contiene el correo del destinatario
      Set objOutlookRecip = .Recipients.Add("micorreo@correo.com")
      objOutlookRecip.Type = olTo
      .Subject = "Atención: Se ha abierto el archivo " & ThisWorkbook.Name
      .Body = "El archivo " & ThisWorkbook.Name & _
         " fue abierto por " & strUser & " el " & Date & " a las " & Time & _
            " h." & vbLf & vbLf
      objOutlookRecip.Resolve
      .Send
   End With
   Set objOutlook = Nothing
End Sub

Y este otro en un módulo estándar:

Option Explicit

Declare Function GetUserName Lib "advapi32.dll" _
    Alias "GetUserNameA" (ByVal lpBuffer As String, _
    nSize As Long) As Long

Function cptName()
   Dim Buffer As String * 100
   Dim BuffLen As Long
   BuffLen = 100
   GetUserName Buffer, BuffLen
End Function
  • Para que el código funcione correctamente, el usuario debe tener Microsoft Outlook abierto. En caso contrario, se produce un error que es gestionado por la instrucción On Error Resume Next, por lo que no se muestra de ninguna forma.
  • Si deseas implementar este código en otro archivo, tienes que habilitar la referencia a Microsoft Outllook 14 Object Library.

Si tienes cualquier duda puedes plantearla en el foro de Ayuda Excel.

envio_0
Título: envio_0 (200 clics)
Tamaño: 17 KB

 

¿Me ayudas a promocionar este contenido?

Share on facebook
Facebook
Share on google
Google+
Share on twitter
Twitter
Share on linkedin
LinkedIn
Consultoría plantillas Excel
Foro Excel
La destreza y el perfeccionismo quizá sean las dos virtudes que me permiten ayudar a mis clientes a facilitar las tareas administrativas de sus negocios... y son las culpables de que me guste el origami. +info.

¿Quieres ahorrarte horas de trabajo diario?

macros excel manual

Descarga este informe y aprenderás a crear tus propias macros de forma rápida y sencilla

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Gestionar y enviar información de boletines y promociones a través de correo electrónico.

Legitimación: Consentimiento del interesado.

Destinatarios: Tus datos se encuentran alojados en mi hosting Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.