Excel que envía por mail el texto contenido en varias celdas que varían dependiendo del valor ingresado en un textbox
¿Cómo están?
En primer lugar agradecer su tiempo y dedicación.
Ahora les planteo mi problema: tengo una hoja de calculo que contendrá diferentes comunicaciones internas de mi oficina. La idea es que con un botón de "Comunicar" se inicie una Macro que abre un formulario donde solicita ingresar (en un textbox) el Número correlativo de comunicación que se quiere enviar a los funcionarios.
Una vez ingresado el valor, debería de buscarlo en la coluna "B". Al encontrarlo debería de copiar el texto de la celda ubicada en la fila donde encontró el valor del textbox y columna "J".
Hecho esto, en la misma fila donde encontró el valor del textbox, pero en la columna "AJ" debería de escribir la fecha actual.
Imagen de ejemplo:
El código que tengo hasta ahora dentro del formulario es:
Private Sub Comunicar_Click()
End Sub
Private Sub Accept2_Click()
Entrada = TextBox2
Dim i, j As Integer
Dim pagina1 As Worksheet
Dim OutApp As Object
Dim Correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
'Find.Entrada
'Select.
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Crear el correo y mostrarlo
With Correo
.To = "[email protected]"
.CC = "[email protected]; [email protected]"
.Subject = "Comunicado interno número " & Entrada
.HTMLBody = "Se le pone en conocimiento que de acuerdo al comunicado interno Nº" & Entrada
.Display
'Correo.Send
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Unload Me
MsgBox "Comunicación realizada con éxito", vbExclamation, "COMUNICACIÓN REALIZADA"
End Sub
Private Sub Cancel2_Click()
Unload Me
MsgBox "La comunicación no se ha enviado", vbCritical, "COMUNICACIÓN CANCELADA"
End Sub
Private Sub UserForm_Click()
End Sub
Les dejo el link para descargar el excel para que lo puedan visualizar mejor: Descargar archivo excel
1 respuesta
No puedo descargar archivos, envíame tu archivo por correo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Eugenio Lemes”
S a l u d o s . D a n t e A m o r
Te anexo la macro actualizada
Private Sub Accept2_Click()
'Act.Por.Dante Amor
Dim i, j As Integer
Dim pagina1 As Worksheet
Dim OutApp As Object
Dim Correo As Object
Dim Entrada, b
'
Entrada = TextBox2
If Entrada = "" Or Not IsNumeric(Entrada) Then Exit Sub
Entrada = Val(Entrada)
'
Set b = ActiveSheet.Range("B:D").Find(Entrada, lookat:=xlWhole)
If b Is Nothing Then
MsgBox "No existe el número", vbCritical
Exit Sub
End If
'
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Crear el correo y mostrarlo
With Correo
.To = "[email protected]"
.CC = "[email protected]; [email protected]"
.Subject = "Comunicado interno número " & Entrada
.HTMLBody = "Se le pone en conocimiento que de acuerdo al comunicado interno Nº " & _
Entrada & "<br>" & Cells(b.Row, "J")
. Display
'.Send
End With
'
'Pone la fecha actual
Cells(b.Row, "AJ") = Date
Unload Me
MsgBox "Comunicación realizada con éxito", vbInformation, "COMUNICACIÓN REALIZADA"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
