¿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 = "correo@hotmail.com" 'Destinatarios dam.CC = "otro@yahoo.com" '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 "correo@hotmail.com", por tu correo.
Si quieres enviar con copia para, cambia esto: "otro@yahoo.com" 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", "micorre@hotmail.com", "Hola", "" End Sub
De lo anterior ejecuta la macro mensaje.
Cambia "micorre@hotmail.com" 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", "micorre@hotmail.com", "Hola", "" End If End Sub
- Compartir respuesta