Como Filtrar por Cliente Rango de Fechas y Enviar Mail Datos en el Cuerpo Mensaje

Hoy se mostrará como Filtrar por Cliente, Rango de Fechas y Exportar lo Filtrado Enviando por Mail, los datos a enviar por mail se irán en el cuerpo del mensaje, en otras palabras se puede filtrar por cliente sumarle si es preciso un filtro por fecha de inicio y fecha de fin, mostrando los datos coincidentes en un Listbox, luego esos datos contenidos en el Listbox, se enviarán por mail e irán en el cuerpo del mensaje, no en archivo adjunto.

Si requieres saber más sobre envío de mail desde Excel sugiero que visites el link, encontrarán decenas de ejemplos de macros que muestran como enviar mail con excel con distintas variantes.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.

if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}

Este ejemplo es una variante de una saga de tutoriales relacionados, anteriormente se exportó a TXT, PDF, WORD y varios ejemplos más, el producto de un filtro en Excel por Cliente y Rango de Fechas, en este ejemplo la macro Filtra por Rango de Fechas a lo cual si es requerido se puede adicionar un Filtro por Fechas, una que se han obtenido los datos requeridos, se muestran en un Listbox, esta macro básicamente envía por Mail mediante Outlook los datos filtrados y que se están mostrando en el Listobx de Excel.

Al descargar el ejemplo, en la hoja de Excel hay un botón que muestra un formulario, en el se puede ingresar un cliente y filtrar los datos de la base de datos, en este caso está en la Hoja1, pero cada quien lo puede tranquilamente adaptar a su proyecto, en el mismo formulario se encuentra dos textbox para poder ingresar fecha de inicio y fin pudiendo añadir al filtro realizado por cliente un filtro por fecha, todo esto se muestra en el listbox, que se puede enviar por mail dichos datos irán en el cuerpo del mensaje.

En el ícono con @ se encuentra la codificación para poder enviar los datos que se muestran en el listbox por mail con Excel, cuyo correo electrónico enviado contendrá los datos del listbox en el cuerpo del mensaje, en otra ejemplo se presenta como enviarlo en archivo adjunto, también como usar Gmail o Yahoo para envíar el correo, este ejemplo utiliza Outlook par el envió del mensaje electrónico.

Seguidamente se analiza el código utilizado, pero básicamente para ellos se crea una hoja temporal, los datos cuyo filtro se requirió y están mostrados en el listbox se copian a la hoja temporal usándose para enviar los datados por mail, para luego se eliminada, todo esto ocurren en muy pocos segundos por lo que el usuario no ve que hace la macro para enviar el mail, solo ve el producto final que es el mail enviado con los datos del listbox.

La macro crea una hoja, que es la hoja temporal que se usa y que luego se elimina, esto se hace con los siguientes códigos.

Sheets(«DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»).Delete

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

ActiveSheet.name = «DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»

Set a = Sheets(«DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»)

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Quizá sea de utilidad también

Como Filtrar por Rango de Fechas y Exportar a TXT

Como Comprimir Archivos con Una Macro de Excel

Como Copiar un Hiperlynk con Macro de Excel

Seguidamente se copian los datos del listbox a la hoja de Excel así:

For x = 1 To UserForm1.ListBox1.ListCount – 5

a.Cells(x + 2, «A») = ListBox1.List(x, 0)

a.Cells(x + 2, «B») = CDate(ListBox1.List(x, 1))

a.Cells(x + 2, «C») = ListBox1.List(x, 2)

a.Cells(x + 2, «D») = ListBox1.List(x, 3)

a.Cells(x + 2, «E») = ListBox1.List(x, 4)

a.Cells(x + 2, «F») = ListBox1.List(x, 5)

a.Cells(x + 2, «G») = CDec(ListBox1.List(x, 6))

En forma posterior se le da un poco de formato al informe o reporte creado esto es formato fecha, decimal, ancho de columnas, ancho automático etc., cada uno deberá adornar el reporte a sus gusto o como debe presentarlo, esto se hace con los siguientes códigos:

a.Range(«G2:G» & uf).NumberFormat = «#.#,0»

a.Range(«B2:B» & uf).NumberFormat = «dd/mm/yyyy»

a.Range(«A:G»).Columns.AutoFit

a.Range(«A:A»).ColumnWidth = 31

Ahora viene la parte donde se crea y envía el mail propiamente dicho, se usa una herramienta que viene incorporad en Excel para el envío de mails, el código es el siguiente:

Dest = Me.TextBox4

Set srang = a.Range(«A1:G» & uf)

With srang

.Parent.Select

.Select

ActiveWorkbook.EnvelopeVisible = True

With .Parent.MailEnvelope

.Introduction = «Reportes de ventas mensuales detalladas»

With .Item

.To = Dest

.Subject = «Reportes de » & nom & » mensuales»

.send

End With

El código anterior permite que encima de la hoja de Excel se muestren casillas para el envío de mail, obvió que esto no lo ve el usuario porque la macro lo hace internamente, pero si se recorre o ejecuta la macro paso a paso se podrá observar lo mencionado.

Lo que se hace es crea un rango con la tabla que se creó al pasar los datos del listbox a la hoja de Excel, a ese rango se lo envía por mail en el cuerpo del mensaje utilizando el código anterior, para ello el destinatario lo obtiene del formulario de Excel, donde previamente se debe cargar la dirección de mail para poder proceder a enviar el mail, con el comando Send se envía el mail.

Para finalizar sale un msgbox avisando que la macro ha finalizado y la macro elimina la hoja creada en forma temporal, se usa la siguiente codificación.

MsgBox («El mail se envió con éxito»), vbInformation, «AVISO»

ActiveWorkbook.EnvelopeVisible = False

a.Delete

La macro denominada Como Filtrar por Cliente Rango de Fechas y enviar Por Mail con Datos en el Cuerpo del Mensaje, se puede descargar desde el final sin ninguna restricción, a continuación se agrega toda la codificación del ejemplo ya sea de el formulario como del módulo que forma parte del mismo.

Código que se inserta en un Formulario de Excel

‘**************https://macrosenexcel.com **** https://youtube.com/programarexcel*********

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato2 = Empty Or dato1 = emtpy Then
MsgBox («Debe ingresar datos para consulta entre rango de fechas»), vbCritical, «AVISO»
Exit Sub
End If
If dato2 < dato1 Then
MsgBox («La fecha final no puede ser mayor a la fecha inicial»), vbCritical, «AVISO»
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear

‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

If dato1 = Empty Or dato2 = Empty Then

For i = 2 To uf
dato0 = CDate(b.Cells(i, 2).Value)
If dato0 >= dato1 And dato0 <= dato2 Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
End If
Next i

Else

If dato2 < dato1 Then
MsgBox («La fecha final no puede ser mayor a la fecha inicial»), vbCritical, «AVISO»
Exit Sub
End If

For i = 2 To uf
strg = b.Cells(i, 1).Value
dato0 = CDate(b.Cells(i, 2).Value)
If UCase(strg) Like UCase(TextBox1.Value) & «*» And dato0 >= dato1 And dato0 <= dato2 Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
End If
Next i

End If

‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 0) = «Total Importe»

For x = 0 To UserForm1.ListBox1.ListCount – 1
t = CDec(UserForm1.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 1) = Format(tot, » «»U$S»» #,##0.00 «)

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 0) = «Total de registros:»
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 1) = UserForm1.ListBox1.ListCount – 5

Me.ListBox1.ColumnWidths = «170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt»
End Sub

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim srang As Range
If TextBox4 = Empty Then
MsgBox («Debe ingresar mail»), vbCritical, «AVISO»
Exit Sub
End If

‘Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets(«DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»).Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.name = «DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»
Set a = Sheets(«DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»)

For x = 1 To UserForm1.ListBox1.ListCount – 5
a.Cells(x + 2, «A») = ListBox1.List(x, 0)
a.Cells(x + 2, «B») = CDate(ListBox1.List(x, 1))
a.Cells(x + 2, «C») = ListBox1.List(x, 2)
a.Cells(x + 2, «D») = ListBox1.List(x, 3)
a.Cells(x + 2, «E») = ListBox1.List(x, 4)
a.Cells(x + 2, «F») = ListBox1.List(x, 5)
a.Cells(x + 2, «G») = CDec(ListBox1.List(x, 6))
Next

a.Cells(x + 4, «A») = ListBox1.List(x + 2, 0)
a.Cells(x + 5, «A») = ListBox1.List(x + 3, 0)
a.Cells(x + 4, «B») = ListBox1.List(x + 2, 1)
a.Cells(x + 5, «B») = ListBox1.List(x + 3, 1)

a.Activate
a.Range(«A1») = «REPORTE DE VENTAS»

With a.Range(«A1:G1»)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.RowHeight = 20
.Font.Size = 16
End With

a.Range(«A2») = «CLIENTE»
a.Range(«B2») = «FECHA»
a.Range(«C2») = «COMPROBANTE»
a.Range(«D2») = «TIPO»
a.Range(«E2») = «SUC»
a.Range(«F2») = «N COMP»
a.Range(«G2») = «IMPORTE»
uf = a.Range(«G» & Rows.Count).End(xlUp).Row
a.Range(«G2:G» & uf).NumberFormat = «#.#,0»
a.Range(«B2:B» & uf).NumberFormat = «dd/mm/yyyy»
a.Range(«A:G»).Columns.AutoFit
a.Range(«A:A»).ColumnWidth = 31

Dest = Me.TextBox4
Set srang = a.Range(«A1:G» & uf)
With srang
.Parent.Select
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = «Reportes de ventas mensuales detalladas»
With .Item
.To = Dest
.Subject = «Reportes de » & nom & » mensuales»
.send
End With
End With
End With
a.Select
MsgBox («El mail se envió con éxito»), vbInformation, «AVISO»
ActiveWorkbook.EnvelopeVisible = False
a.Delete
Sheets(«Hoja1»).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub Label2_Click()
TextBox4.SetFocus
End Sub

Private Sub ListBox3_Click()
On Error Resume Next

UserForm1.TextBox4 = Empty
fila = UserForm1.ListBox3.ListIndex

UserForm1.TextBox4 = UserForm1.ListBox3.List(fila, 1)

UserForm1.ListBox3.Visible = False

If TextBox4 = Empty Then
UserForm1.Label2.Visible = True ‘hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If TextBox8 = Empty Then
UserForm1.Label1.Visible = True ‘hace visible el label
Else
UserForm1.Label1.Visible = False
End If
Me.CommandButton4.SetFocus
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
Me.ListBox1.RowSource = «Hoja1!A1:G» & uf
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

For i = 2 To uf
strg = b.Cells(i, 1).Value
If UCase(strg) Like UCase(TextBox1.Value) & «*» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
End If
Next i

‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 0) = «Total Importe»

UserForm1.TextBox2 = Clear
UserForm1.TextBox3 = Clear

Me.ListBox1.ColumnWidths = «170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt»
End Sub

Private Sub TextBox2_Change()
If Len(UserForm1.TextBox2) = 10 Then UserForm1.TextBox3.SetFocus
End Sub

Private Sub TextBox3_Change()
If Len(UserForm1.TextBox3) = 10 Then UserForm1.CommandButton2.SetFocus
End Sub

Private Sub TextBox4_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim cn As ADODB.Connection, rs As ADODB.Recordset

If TextBox4 = Empty Then
UserForm1.Label2.Visible = True ‘hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If Len(UserForm1.TextBox4) <= 2 Then
UserForm1.ListBox3.Visible = False
Exit Sub
Else
UserForm1.ListBox3.Visible = True
End If

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets(«Agenda»)

cn.Open «Provider=Microsoft.ACE.OLEDB.12.0;» & «Data Source=» & ThisWorkbook.FullName & «;Extended Properties=»»Excel 12.0;HDR=Yes;»»»

If Len(UserForm1.TextBox4) > 2 Then
Sql = «SELECT * FROM [» & «Agenda$» & «] WHERE Ucase(» & a.Range(«A1») & «) LIKE Ucase(‘%» & UserForm1.TextBox4 & «%’) ORDER BY Nombre ASC»
Set rs = cn.Execute(Sql)

UserForm1.ListBox3.Clear

If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
UserForm1.ListBox3.Visible = False
Exit Sub
Else

UserForm1.ListBox3.Column = 3
UserForm1.ListBox3.ColumnWidths = «70 pt;100 pt;80 pt»

rs.MoveFirst
Do While Not rs.EOF
UserForm1.ListBox3.AddItem rs.Fields(0).Value
UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount – 1, 1) = rs.Fields(1).Value
UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount – 1, 2) = rs.Fields(2).Value
rs.MoveNext
Loop
End If

End If
Set rs = Nothing
cn.Close
Set cn = Nothing

‘Si solo hay un dato coincidente directamente lo busca y carga sus datos, al seleccionarlo se ejecuta el evento click del listbox
If UserForm1.ListBox3.ListCount – 1 = 0 Then
UserForm1.ListBox3.Selected(0) = True
UserForm1.ListBox3.Visible = False
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)
With Me.ListBox1
.ColumnCount = 7
.ColumnWidths = «170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt»
.RowSource = «Hoja1!A1:» & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub

Código que se inserta en un módulo

‘******https://macrosenexcel.com https://youtube.com/programarexcel*

#If VBA7 And Win64 Then

‘Si es de 64 bits

Public Declare PtrSafe Function ShellExecute Lib «shell32.dll» Alias «ShellExecuteA» (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Public Declare PtrSafe Function FindWindow Lib «USER32» Alias «FindWindowA» (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Public Declare PtrSafe Function GetWindowLongPtr Lib «USER32» Alias «GetWindowLongPtrA» (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

Public Declare PtrSafe Function SetWindowLongPtr Lib «USER32» Alias «SetWindowLongPtrA» (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Public Declare PtrSafe Function DrawMenuBar Lib «USER32» (ByVal hwnd As Long) As LongPtr

Public Declare PtrSafe Function RegOpenKeyA Lib «advapire32.dll» (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As LongPtr

#Else

‘Si es de 32 bits

Public Declare Function ShellExecute Lib «shell32.dll» Alias «ShellExecuteA» (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function FindWindow Lib «USER32» Alias «FindWindowA» (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetWindowLong Lib «USER32» Alias «GetWindowLongA» (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib «USER32» Alias «SetWindowLongA» (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function DrawMenuBar Lib «USER32» (ByVal hwnd As Long) As Long

Public Declare Function RegOpenKeyA Lib «advapire32.dll» (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

#End If

Sub muestra1()

UserForm1.Show

End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends