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

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.

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

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

Summary

Author Rating

Aggregate Rating

no rating based on 0 votes