¿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 Respuesta
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 SubCambia 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)
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
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 SubDe 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
- Compartir respuesta