Macro enviar correo según valor de celda
Lo que necesito es enviar la hoja activa de una planilla a un destinatario que aparecerá en una celda predeterminada (L39). Me explico mejor, tengo dos casillas de verificación (checklist) y cuando selecciono una, me arroja el nombre de una persona por la famosa formula del BUSCARV y la otra lo mismo. Por esto mismo necesito saber el código de una macro para que cuando yo ejecute un botón de comando, éste envié la hoja activa de acuerdo al nombre que aparece en la celda (L39). Cabe mencionar con la cuenta de correo también ya la tengo en la base de datos en otra hoja. Al final que la macro haga como un buscarv, arroje el valor pero que pueda enviar la hoja por correo.
1 Respuesta
H o l a:
Para enviar el correo se necesitan de estos datos:
- ¿La vas a enviar por outlook?
- ¿Qué lleva el asunto?
- ¿Qué va en el cuero del correo?
- ¿Cómo se llama tu hoja de la base de datos donde tienes los nombres?
- ¿En cuál columna están los nombres y en cuál columna está el correo?
- ¿La hoja se va a enviar como archivo? ¿Qué nombre se le va a poner al archivo?
E spero tus comentarios en ese orden.
Sal u dos
- por outlook
- el asunto llevará "Autorización para creación de Proyecto en Primavera"
- En el body "Favor confirmar solicitud"
- La hoja se llama REQ y los nombres están en la columna BZ y los correos en la columna CC
- La hoja que se enviará es la misma (REQ) y el nombre del archivo se debe llamar requerimiento_creación y la fecha actual, no importa el formato de fecha.
De antemano muchas gracias
Disculpa, pero estoy confundido.
Ya no entiendo en dónde están los dato y en dónde la base de datos.
Mejor envíame tu archivo con tus 2 hojas y me dices cuál es la hoja que se va a enviar.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Cristian Majluf” y el título de esta pregunta.
Estimado, te acabo de enviar más información. Planilla más pantallazos.
Muchas gracias
Te anexo las macros
Sub ValidaryEnviar()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If comprobarceldas Then
If validar_seccion Then
Call EnviarCorreo
MsgBox "Correo enviado"
End If
End If
End Sub
'
Sub EnviarCorreo()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = l1.Path & "\"
h1.Copy
Set l2 = ActiveWorkbook
archivo = "requerimiento_creación " & Format(Date, "dd-mm-yyyy") & ".xls"
l2.SaveAs Filename:=ruta & archivo, FileFormat:=xlNormal
l2.Close
Set dam = CreateObject("outlook.application").createitem(0)
Set h2 = Sheets("DATOS")
Set b = h2.Columns("L").Find([L39], lookat:=xlWhole)
If Not b Is Nothing Then
correo = b.Offset(0, 1)
dam.To = correo
dam.Subject = "Autorización para creación de Proyecto en Primavera"
dam.body = "Favor confirmar solicitud"
dam.Attachments.Add ruta & archivo
dam.send
'dam.display
End If
End Sub
Function validar_seccion()
validar_seccion = False
If ActiveSheet.diseño = Empty And ActiveSheet.construccion = Empty Then
MsgBox "Selecciona SECCION", vbInformation, "PMO"
Range("I9").Select
Exit Function
ElseIf ActiveSheet.diseño = True And ActiveSheet.construccion = True Then
MsgBox "Debes Seleccionar sólo una SECCION", vbInformation, "PMO"
Range("I9").Select
Exit Function
End If
validar_seccion = True
End Function
Function comprobarceldas()
comprobarceldas = False
If Range("G8") = Empty And Range("G8").HasFormula = False Then
MsgBox "Ingresa NOMBRE", vbInformation, "PMO"
Range("G8").Select
Exit Function
End If
If Range("G9") = Empty And Range("G9").HasFormula = False Then
MsgBox "Ingresa RUT", vbInformation, "PMO"
Range("F9").Select
Exit Function
End If
If Range("G10") = Empty And Range("G10").HasFormula = False Then
MsgBox "Ingresa ETAPA", vbInformation, "PMO"
Range("G10").Select
Exit Function
End If
If Range("G12") = Empty And Range("G12").HasFormula = False Then
MsgBox "Ingresa NOMBRE DE PROYECTO", vbInformation, "PMO"
Range("G12").Select
Exit Function
End If
If Range("G13") = Empty And Range("G13").HasFormula = False Then
MsgBox "Ingresa TIPO", vbInformation, "PMO"
Range("G13").Select
Exit Function
End If
If Range("M14") = 0 And Range("g14") = "" Then
MsgBox "Falta Información del código BIP", vbInformation, "PMO"
Range("F14").Select
Exit Function
End If
If Range("G15") = Empty And Range("G15").HasFormula = False Then
MsgBox "Ingresa RATE", vbInformation, "PMO"
Range("G15").Select
Exit Function
End If
If Range("G17") = Empty And Range("G17").HasFormula = False Then
MsgBox "Ingresa ADMINISTRACION ZONAL", vbInformation, "PMO"
Range("G17").Select
Exit Function
End If
If Range("G19") = Empty And Range("G19").HasFormula = False Then
MsgBox "Ingresa COMPETENCIA", vbInformation, "PMO"
Range("G19").Select
Exit Function
End If
If Range("F23") = Empty And Range("F23").HasFormula = False Then
MsgBox "Ingresa JP RESPONSABLE", vbInformation, "PMO"
Range("F23").Select
Exit Function
End If
If Range("F25") = Empty And Range("F25").HasFormula = False Then
MsgBox "Ingresa JP DISEÑO", vbInformation, "PMO"
Range("F25").Select
Exit Function
End If
If Range("F27") = Empty And Range("F27").HasFormula = False Then
MsgBox "Ingresa JP CONSTRUCCION", vbInformation, "PMO"
Range("F27").Select
Exit Function
End If
comprobarceldas = True
End Function':) ':)
