Como Enviar Whatsapp en Forma Masiva desde Excel con Buscador Contacto

En este ejemplos se presenta una macro solicitada por un suscriptor de nuestro canal de YouTube, el cual requería enviar Whatsapp desde Excel en forma masiva, pero que contenga un buscador de contactos, en esta macro se responde lo solicitado adicionando un buscador avanzado de datos de Excel.

Este 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.

El vídeo explica en forma más detallada el ejemplo contenido en este post, suscribe a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes.

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);
}
}

El ejemplo se puede descargar en forma totalmente gratuita desde el final del post, cuando se abre el libro, se observa un botón que presionando muestra un formulario, el cual contiene un buscador avanzado que permite encontrar los contactos en la base de datos e ir marcándolos para enviar un whatsapp masivo desde Excel a todos los contactos seleccionados.

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

Quizá sea de utilidad también

Como crear una factura con excel, guardarla, guardar en PDF e enviar por mail

Como auto eliminar archivo previo copiar el fichero

Como hacer un bucle for … next con letras del abecedario en vez de números

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

Escribiendo en el textbox que se encuentra en el formulario, los datos de los contactos, al ingresar las primeras 3 letras empieza a buscar en la base de datos y carga los registros que tengan coincidencias con lo escrito en el listbox, que está oculto y solo se hace visible para mostrar los resultados del filtro.

Seleccionado el item (contacto) del listbox automáticamente busca el registro en el listbox de la derecha marcándose el contacto como a quien se le debe enviar Whatsapp desde Excel.

El listbox se oculta y muestra solamente en el caso que la búsqueda haya sido satisfactoria, es decir si encontró algún dato que coincida con lo escrito, lo mismo sucede con el label que se encuentra encima del textbox que se oculta en caso que el textbox sea distinto de vacío y muestra cuanto el textbox está vacío.

Una vez seleccionados todos los contactos a los cuales se les requiere enviar el Whatsapp, presionando el botón de la aplicación, botón verde, se procede a enviar un mensaje a cada uno de los contactos seleccionados, en envío será más o menos rápido dependiendo de la velocidad de internet.

Para enviar el Whatsapp se requiere que esté activado Whatsapp Web, estando activado la macro leerá todos los registros marcados en el listbox de la derecha enviando un mensaje de Whatsapp a todos aquellos seleccionados solamente, desde luego se puede seleccionar directamente si hacer uso del buscador de contactos, el cual es más útil cuando la base de datos es extensa.

Para buscar el dato escrito en el textbox y compararlo con el contacto que está en la columna A de la base de datos, se utiliza SQL, conectándose con el mismo libro a través de una conexión ADODB y mediante sentencias SQL se procede a obtener los datos coincidentes con lo escribo para mostrar en el listbox, sugiero descargar el ejemplo y ver el vídeo donde se verá la macro en acción, donde además se tiene una explicación más detallada de los códigos.

Considera aportar para sostener el sitio si está dentro de tus posibilidades, a continuación se muestra el código completo del ejemplo Como Enviar Whatsapp en Forma Masiva desde Excel con Buscador de Contacto.

Código que se inserta en un formulario

‘******https://macrosenexcel.com https://youtube.com/programarexcel*
Private Sub CommandButton1_Click()
Dim Num As New Collection, dato, conta As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
‘Crea una colección de datos del listbox
Set aa = UserForm1.ListBox1
For x = 0 To aa.ListCount – 1
If aa.Selected(x) = True Then
Num.Add aa.List(x, 1)
End If
Next x
conta = 0
For Each dato In Num
conta = conta + 1
telwhatsapp = dato
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
Next dato
MsgBox («Se envió Whatsapp a » & conta & » contactos»), vbInformation, «REPORTE»
cancont = 0 ‘devuelve el a cero cuando se seleccionan varios contactos para que en el listbox no los borre nuevamente
End Sub
Private Sub Label2_Click()
TextBox9.SetFocus
End Sub
Private Sub ListBox3_Click()
On Error Resume Next
UserForm1.TextBox8 = Empty
fila = UserForm1.ListBox3.ListIndex
UserForm1.TextBox8 = UserForm1.ListBox3.List(fila, 0) & » » & UserForm1.ListBox3.List(fila, 1) & » » & UserForm1.ListBox3.List(fila, 2)
UserForm1.TextBox9 = Clear
contacto = UserForm1.ListBox3.List(fila, 0)
UserForm1.ListBox3.Visible = False
If TextBox9 = 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
Set a = UserForm1.ListBox1
For x = 1 To a.ListCount – 1
If cancont = 1 Then GoTo sale:
If a.Selected(x) = True Then a.Selected(x) = False
sale:
If a.List(x, 0) = contacto Then a.Selected(x) = True
Next x
cancont = 1 ‘Hace que no se desmarque los contactos ya marcados
End Sub
Private Sub CommandButton2_Click()
Set a = UserForm1.ListBox1
For x = 1 To a.ListCount – 1
If a.Selected(x) = True Then
a.Selected(x) = False
GoTo sal:
End If
If a.Selected(x) = False Then a.Selected(x) = True
sal:
Next x
End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox2
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox3
End Sub
Private Sub TextBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
TextBox1 = TextBox4
End Sub
Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = «Expte: » & UserForm1.TextBox2 & » Caratula » & UserForm1.TextBox3
TextBox1 = TextBox5
End Sub
Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = «Expte: » & UserForm1.TextBox2 & » Caratula » & UserForm1.TextBox3
TextBox1 = TextBox6
End Sub
Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = «Expte: » & UserForm1.TextBox2 & » Caratula » & UserForm1.TextBox3
TextBox1 = TextBox7
End Sub
Private Sub TextBox8_Change()
If TextBox8 = Empty Then
UserForm1.Label1.Visible = True ‘hace visible el label
Else
UserForm1.Label1.Visible = False
End If
End Sub
Private Sub TextBox9_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim cn As ADODB.Connection, rs As ADODB.Recordset
If TextBox9 = Empty Then
UserForm1.Label2.Visible = True ‘hace visible el label
Else
UserForm1.Label2.Visible = False
End If
If Len(UserForm1.TextBox9) <= 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(«Hoja1»)
cn.Open «Provider=Microsoft.ACE.OLEDB.12.0;» & «Data Source=» & ThisWorkbook.FullName & «;Extended Properties=»»Excel 12.0;HDR=Yes;»»»
If Len(UserForm1.TextBox9) > 2 Then
sql = «SELECT * FROM [» & «Hoja1$» & «] WHERE Ucase(» & a.Range(«A1») & «) LIKE Ucase(‘%» & UserForm1.TextBox9 & «%’) ORDER BY Contacto 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 = «100 pt;70 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 cn As ADODB.Connection, rs As ADODB.Recordset, sql As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ExpteWhatsapp = «SUSCRIBE https://www.youtube.com/c/programarexcel?sub_confirmation=1»
UserForm1.TextBox1 = ExpteWhatsapp
UserForm1.TextBox2 = «Estimado recuerda » & ExpteWhatsapp & » activa la campanita y YouTube te avisara cuando se suba nuevo contenido «
UserForm1.TextBox3 = «Automatiza tus Libros Excel, tutoriales semanales, recuerda » & ExpteWhatsapp & » todas las semanas ideas sobre como automatizar tus libros Excel «
UserForm1.TextBox4 = «Mis datos son:» & Chr(13) & » https://www.youtube.com/c/programarexcel?sub_confirmation=1 » & Chr(13) & » comenta, dale LIKE si te fue útil»
UserForm1.TextBox5 = «Recuerda darle LIKE Y COMENTAR SI FUE UTIL: » & Chr(13) & «RECUERDA » & ExpteWhatsapp
UserForm1.TextBox6 = «Su próxima factura de ProgramarExcel.com vence el: » & Chr(13) & «14/06/2020 «
UserForm1.TextBox7 = «https://macrosenexcel.com Descarga cientos de ejemplos de Macros de Excel GRATIS, aporta al canal si puedes, sino con like, comentario y suscripción es suficiente»
UserForm1.ListBox1.ColumnCount = 2
UserForm1.ListBox1.ColumnWidths = «80 pt; 60 pt»
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets(«Hoja1»)
cn.Open «Provider=Microsoft.ACE.OLEDB.12.0;» & «Data Source=» & ThisWorkbook.FullName & «;Extended Properties=»»Excel 12.0;HDR=Yes;»»»
sql = «SELECT * FROM [» & «Hoja1$» & «]»
Set rs = cn.Execute(sql)
If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
Else
UserForm1.ListBox1 = Clear
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
rs.MoveFirst
Do While Not rs.EOF
UserForm1.ListBox1.AddItem rs.Fields(0).Value
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount – 1, 1) = rs.Fields(1).Value
rs.MoveNext
Loop
‘Carga los datos de la cabecera en listbox
For ii = 0 To rs.Fields.Count – 1
UserForm1.ListBox1.List(0, ii) = rs.Fields(ii).Name
Next ii
‘Selecciona todos los items
For x = 1 To UserForm1.ListBox1.ListCount – 1
UserForm1.ListBox1.Selected(x) = True
Next x
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Código que se inserta en un módulo

‘******https://macrosenexcel.com https://youtube.com/programarexcel*
Public telwhatsapp, textwhatsapp, cancont
Sub Muestra()
UserForm1.Show
End Sub
Sub EnviaWhatsapp()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If telwhatsapp = Empty Or textwhatsapp = Empty Then
MsgBox («Debe ingresar número de telefono y texto para enviar Whatsapp»), vbCritical, «AVISO»
Exit Sub
End If
mylinkwhatsapp = «https://api.whatsapp.com/send?phone=» & telwhatsapp & «&text=» & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp
Application.Wait (Now + TimeValue(«00:00:05»))
ActiveWindow.Application.SendKeys «{TAB}»
Application.Wait (Now + TimeValue(«00:00:01»))
ActiveWindow.Application.SendKeys «{TAB}»
Application.Wait (Now + TimeValue(«00:00:05»))
ActiveWindow.Application.SendKeys «(~)» ‘énvia enter para enviar mensaje
Application.Wait (Now + TimeValue(«00:00:18»))
ActiveWindow.Application.SendKeys «(~)»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
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