¿Cómo hacer macro para recibir notificación vía correo electrónico cada vez que se guarda el archivo?

Quiero que cada vez que alguien guarda un archivo excel en nuestra red, yo reciba una notificación vía correo electrónico avisándome. Excepto cuando lo haga desde mi IP.
Es posible?
Gracias!

1

1 respuesta

Respuesta
1

Primero debes obtener tu número de IP.

Pon lo siguiente en un módulo dentro del archivo.

Sub miip()
'Por.Dante Amor
    MsgBox GetIPAddress
End Sub
Function GetIPAddress()
'Referencia: http://stackoverflow.com/questions/828496/how-to-retrieve-this-computers-ip-address
    Const strComputer As String = "."   ' Computer name. Dot means local computer
    Dim objWMIService, IPConfigSet, IPConfig, IPAddress, i
    Dim strIPAddress As String
    ' Connect to the WMI service
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    ' Get all TCP/IP-enabled network adapters
    Set IPConfigSet = objWMIService.ExecQuery _
        ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
    ' Get all IP addresses associated with these adapters
    For Each IPConfig In IPConfigSet
        IPAddress = IPConfig.IPAddress
        If Not IsNull(IPAddress) Then
            strIPAddress = strIPAddress & Join(IPAddress, ", ")
        End If
    Next
    GetIPAddress = strIPAddress
End Function

Si revisas van 2 macros una macro llamada "miip" y una función llamada: "GetIPAddress", bueno ejecuta la macro "miip" y te va a arrojar un msjbox con tu número de ip

Toma nota del número tal cual aparece en el mensaje.


Ahora deberás poner la siguiente macro en el mismo archivo pero en los eventos de workbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Por.Dante Amor
    midir = GetIPAddress
    If midir <> "0.0.0.020.235.18.1" Then
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = "[email protected]" 'Destinatarios
        dam.CC = "[email protected]" 'Con copia
        dam.Subject = "Guardaron el archivo" '"Asunto"
        dam.body = "el archivo se guardó a las " & Time() '"Cuerpo del mensaje"
        dam.send 'El correo se envía en automático
        'dam.display 'El correo se muestra
    End If
End Sub

Cambia en la macro este número: "0.0.0.020.235.18.1" por el número que anotaste.
Cambia en la macro "[email protected]", por tu correo.

Si quieres enviar con copia para, cambia esto: "[email protected]" por el correo que desees.

Cambia esto: "Guardaron el archivo" por el texto que quieras que aparezca en el asunto del correo.

Y cambia esto: "el archivo se guardó a las " & Time() por el texto que quieras que aparezca en el cuerpo del correo.


4. Del lado derecho copia la macro


Recuerda poner todas las macros en el archivo en cuestión. El archivo lo deberás guardar como excel habilitado para macros. Cuando lo abran deberán habilitar las macros.

Si tienes dudas de algo avísame.

Saludos. Dante Amor

Recuerda valorar la respuesta.

Como introduzco tu código en el workbook si ya tengo este?

Private Sub Workbook_Open()
'Por Eric M.: Abrir en casilla Nok
Dim i As Integer
i = 1
While LCase(Cells(i, "B")) = "ok"
i = i + 1
Wend
Cells(i, "A").Select
'Por Eric M.: Cerrar Excel sin guardar
Application.OnTime Now + TimeValue("00:05:00"), "cerrar"
End Sub
Gracias

Además si lo intento sin mezclar me da error en esta linia:

Set dam = CreateObject("outlook.application").createitem(0)

La función miip me devuelve este mensaje:

192.168.1.131,fe80::a8cb:1503:8345:bc94
Saludos y gracias!

1. Pon mi código en workbook abajo del que ya tienes.

2. ¿Tienes outlook en tu máquina?, el código es para enviar correo a través outlook, si no lo tienes, dime con qué correo se va a enviar, puede ser gmail o hotmail o yahoo.

3. Copia todo el mensaje que te devolvió la función miip y ponlo en la macro en esta parte:

If midir <> "0.0.0.020.235.18.1" Then

Utilizamos correo IBM Notes...

Tendrás que probar con lo siguiente, No puedo probarlo porque no tengo IBM Lotus Notes.

Public Sub SendNotesMail(Subject As String, Recipient As String, BodyText As String, attachment As String)
Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim EmbedObj As Object
    Dim Recip(10) As Variant 'Si hay varios destinatarios
    Dim SaveIt As Boolean
    Dim WasOpen As Integer
    SaveIt = True
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
    If Maildb.IsOpen = True Then
        WasOpen = 1
    Else
        WasOpen = 0
        Maildb.OPENMAIL
    End If
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    If attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    MailDoc.PostedDate = Now()
    MailDoc.SEND 0, Recipient
    'Limpiar
    Range("A1").Select
    Application.CutCopyMode = False
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set EmbedObj = Nothing
    If WasOpen = 1 Then
        Set Session = Nothing
    ElseIf WasOpen = 0 Then
        Session.Close
        Set Session = Nothing
    End If
    MsgBox "El mensaje de correo se ha enviado correctamente", vbOKOnly
End Sub
Sub mensaje()
    SendNotesMail "Prueba", "[email protected]", "Hola", ""
End Sub

De lo anterior ejecuta la macro mensaje.

Cambia "[email protected]"  por tu correo.


Si te funciona entonces cambia la macro de workbook por esto:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Por.Dante Amor
    midir = GetIPAddress
    If midir <> "0.0.0.020.235.18.1" Then
        SendNotesMail "Prueba", "[email protected]", "Hola", ""
    End If
End Sub

Creo que estoy a punto de conseguirlo, te iré informando! Gracias!

Si necesitas algo más avísame.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas