Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

Como Enviar Whatsapp en Forma Masiva con Excel NUEVA Version 2020 #508

Enviar Whatsapp masivamente

Envío MASIVO de Whatsapps desde Excel con Whatsapp Web desde Escritorio Windows

En este post se muestra  Como Enviar Whatsapp en forma MASIVA desde Excel Nueva Versión, la macro utiliza la API oficial de Whatsapp para poder enviar los mensajes de Whatsapp desde Excel,  se utiliza la nueva versión de la Whatsapp Web que se descarga en nuestra PC.

Mejora tu manejo de Excel 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, te lo recomiendo no te arrepentirás.

En 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 nuestro canal de You Tube, mira el playlist con  vídeos relacionados donde podrás ver la macro en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.

 

Envío de Whatsapp desde Excel a Varios Destinatarios a la vez 

Al descargar y abrir el ejemplo Enviar Whatsapp Masivo con Excel, se observa un botón que permite enviar con Excel Varios Mensajes de Whatsapp a la vez.

Al presionar el Botón de Envío de Whtasapp aparece un formulario, donde se debe seleccionar los destinatarios desde el Listbox y luego presionar el botón envíar.

La macro recorrerá cada contacto seleccionado en el listbox que se encuentra en el formulario e irá enviando Whatsapp desde Excel a cada uno de los contactos listados.

 

Explicación de la Macro que Permite Enviar Mensajes a varios Contactos de Whatsapp

Para enviar mensajes a varios destinatarios de  Whatsapp, se debe seleccionar en el listbox los contactos a los cuales se les requiere enviar Whatsapp con Excel, luego la macro hace una colección o listado con esos nombre para luego recorrer cada nombre listado uno por uno enviando Whatsapp a varios destinatarios desde Excel, se usa el código:

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

Como dijimos en el párrafo anterior se recorre cada uno de los contactos listados y se llama a la macro que envía Whatsapp en forma masiva desde Excel, de la siguiente forma.

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

Es válido para el resto de la macro todo lo explicado en el ejemplo 428  Como Enviar Whatsapp en Forma Masiva con Excel, salvo la parte del envío de Whatsapp desde Excel, que es necesario usar el ejemplo que se agrega en este post ya que cambio la API de Whatsapp.



Quizás también interese leer:

Enviar mail con Excel desde Outlook con hoja adjunta 
Envio mail con libro adjunto desde Excel 
Como enviar desde excel Mail con hyperlink link o hipertexto 

 

Descarga del código del aplicativo Enviar En Forma Masiva Whatsapp desde Excel

El ejemplo se puedes descargar desde el final del post, el código se puede adaptar a cada necesidad, aporta a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.

Código que se encuentre en el modulo Envío Whatsapp Masivo

#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
Public Declare PtrSafe Function SetCursorPos Lib «user32» (ByVal x As LongPtr, ByVal y As LongPtr) As LongPtr
Public Declare PtrSafe Sub mouse_event Lib «user32» (ByVal dwFlags As LongPtr, ByVal dx As LongPtr, ByVal dy As LongPtr, ByVal cButtons As LongPtr, ByVal dwExtraInfo As LongPtr)
Public Declare PtrSafe Function SetWindowPos Lib «user32» (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As LongPtr, ByVal y As LongPtr, ByVal cx As LongPtr, ByVal cy As LongPtr, ByVal wFlags As LongPtr) As LongPtr
Public Declare PtrSafe Function SetForegroundWindow Lib «user32» (ByVal hwnd 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
Public Declare Function SetCursorPos Lib «USER32» (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib «USER32» (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Function SetWindowPos Lib «USER32» (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
PUBLIC Declare Function SetForegroundWindow Lib «user32» (ByVal hwnd As Long) As Long

#End If

Public telwhatsapp, textwhatsapp

‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********
Sub Muestra()
UserForm1.Show
End Sub

Sub EnviaWhatsapp()
‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********
Dim hwnd
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:10»))
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «(~)»

Application.Wait (Now + TimeValue(«00:00:18»))
ActiveWindow.Application.SendKeys «(~)»
Application.Wait (Now + TimeValue(«00:00:03»))

End Sub

Código que se encuentra en el 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»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
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 TextBox1_Change()

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$A1:C65000» & «]»

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
catreg = UserForm1.ListBox1.ListCount – 1
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.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407

Summary
Author Rating
1star1star1star1star1star
Aggregate Rating
no rating based on 0 votes