Como Enviar Whatsapp en Forma Masiva con Excel





El ejemplo muestra como mandar Whatsapp desde Excel en forma masiva, la variante anterior se mandaba un mensaje Whatsapp en forma individual, este ejemplo permite enviar un mensaje en forma masiva, se puede seleccionar desde un listbox varios contactos y mandar el mismo mensaje.

Puedes descargar el ejemplo en forma gratuita sin ninguna restricción desde el final del post, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, 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.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.









 



Al descargar el ejemplo se puede observar un botón al ejecutar se muestra un formulario al cargar el mismo se cargan los contactos que están en la base de datos, en este caso en la hoja1; dichos contactos son cargados en un listbox multiselect que está incluido en el formulario.

Con el botón MARCAR/ DESMARCAR se puede seleccionar todos los contactos o desmarcarlos, la macro determinará los contactos marcados enviando un mensaje Whatsapp a cada uno de los contactos seleccionados, realizándose el envío e mensaje Whatsapp desde Excel.

Para enviar el mensaje a los distintos contactos seleccionados se debe, primero marcar a quienes se desea enviar el mensaje seleccionando los contactos en el listbox, luego presionar el botón con el icono de Whatsapp, se procederá establecer que contactos están seleccionados en el listbox y a enviar el Whatsapp desde Excel, no es necesario utilizar el smartphone, solo es necesario previamente habilitar Whatsapp WEB para enviar mensajes de Whatsapp desde Excel.


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como abrir otro libro con password e importar datos


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como sumar datos seleccionados en listbox multiselect

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



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

Al presionar el botón para enviar Whatsapp se ejecuta una macro que es la siguiente:

For x = 0 To aa.ListCount - 1
If aa.Selected(x) = True Then
Num.Add aa.List(x, 1)
End If
Next x

El código anterior crea una colección, denominada Num, con los datos seleccionados del listbox, es decir recorre todas las filas del listbox determinando si está seleccionado el contacto en caso verdadero agrega el número a la colección, hecha la colección con todos los números seleccionados, que es a los contactos que se ele enviará el mensaje, procede a enviar un Whatsapp a cada contacto para ello se usa el siguiente código:

For Each dato In Num
conta = conta + 1
telwhatsapp = dato
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
Next dato

Como se observa en el código anterior, por cada dato que se encuentra en la colección se procede a enviar un mensaje de Whatsapp desde Excel, llamando al procedimiento que permite enviar el mensaje de Whatsapp, lo cual se hacer con el siguiente código:

Call EnviaWhatsapp


Para obtener más detalles como se enviar el mensaje se encuentra explicado con mayor detalle en Como enviar Whatsapp desde Excel, verás en detalle el código que envía el Mensaje de Whatsapp, seguidamente se muestra el código completo y posterior a ello el link para poder descargar el ejemplo.


Código que se inserta en un módulo

Public telwhatsapp, textwhatsapp
Sub Muestra()

'*********** by marcrodos **** https://programarexcel.com  ***  https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********

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

Código que se inserta en un formulario


Private Sub CommandButton1_Click()

'*********** by marcrodos **** https://programarexcel.com  ***  https://www.youtube.com/c/programarexcel?sub_confirmation=1 ************************************

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"
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 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://programarexcel.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

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



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