Como ENVIAR WHATSAPP a Grupos de Whatsapp
En la macro de Excel que se presenta se muestra Como enviar whatsapp a Grupos de Whatsapp con Excel, en este ejemplo se selecciona un grupo de whatsapp que tenemos en nuestro smartphone y se le envía un mensaje de Whatsapp desde Excel al grupo de Whatsapp.
Requieres aprender o mejorar el manejo de Excel, entonces 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 macros relacionadas en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.
Mensajes de WHATSAPP a Grupos de Whatsapp
Como paso número uno, debes descargar el archivo con la Macro, puedes hacerlo desde el final del post, una vez abierto el archivo, se debe seleccionar con el buscador, el Grupo de Whatsapp al que requiramos enviar Whatsapp desde Excel.
Seleccionado el grupo se debe seleccionar el mensaje entre los modelos escritos o escribir el mensaje que se quiera enviar.
luego se debe presionar el botón con el logo de Whatsapp que esta en el formulario, inmediatamente se ejecutará una macro que buscará el contacto elegido y se le enviará el mensaje que se ha escrito o seleccionados de los mensajes modelo.
En este post no se explica como se programa el buscador de contactos inteligente, pero si necesitas saber como se ha programado mira Como Enviar Whatsapp en Forma Masiva desde Excel con Buscador Contacto o el post Punto de Venta con Excel – Busqueda de Clientes, en estos post se explica con detalle como funciona el buscador de contactos.
Quizás también interese leer:
Como Buscar en Hoja Seleccionada y Llenar Listbox
Como Buscar Mientras se Escribe y Cargar Listbox con SQL
Como Eliminar Item al Pasar Datos Listbox a Otro y Guardar
Si quieres aprender más sobre listbox de excel o ver otros ejemplos que podrías aplicar a tus proyectos te invito a ver el playlist sobre Listbox de Excel.
Explicación del Código que Envia Mensajes de Whatsapp a nombre de Grupo de Whatsapp
Cuando se presionó el botón para enviar Whatsapp a Grupo de Whatsapp la macro se cargo en la variable «conw» el nombre del contacto y en la variable «textw» el texto a enviar, con el siguiente código
conw = UserForm1.TextBox8
textw = UserForm1.TextBox1
Call EnviaWhatsapp
Posteriormente se valida que dichas variables no se encuentren vacías en caso contrario finaliza la macro, se usa el siguiente código:
If conw = Empty Or textw = Empty Then
MsgBox («Debe ingresar contacto y texto para enviar Whatsapp»), vbCritical, «AVISO»
Exit Sub
End If
Superado el paso anterior se ejecuta con el comando Shell Whatsapp Web que tenemos instalados en nuestra PC para enviar el mensaje de Whatsapp a Grupos de Whatsapp, se usa el siguiente código.
Shell «C:\Users\MyNotebook\AppData\Local\WhatsApp\WhatsApp.exe»
Una vez que se cargó la aplicación y los chats se comienza a usar SendKey, que son impulsos de teclado para poder enviar el Whatsapp desde Excel, se usan los siguientes códigos:
Se debe tener presente que el envío de Whatsapp depende la conexión a internet, si la misma es lenta o vemos que no se están enviando los Whatsapp desde Excel podemos aumenta la espera que hace la macro antes de ejecutar el código siguiente, con la siguiente coficicación:
Application.Wait (Now + TimeValue(«00:00:03»))
En el código anterior le decimos a la macro que espere desde ya, tres segundos antes de ejecutar el próximo código.
Las pulsaciones de teclado enviadas son las siguientes, con ello se puede enviar un mensaje de Whatsapp a los grupos de Whatsapp.
Application.Wait (Now + TimeValue(«00:00:03»))
ActiveWindow.Application.SendKeys «{TAB}»
Application.Wait (Now + TimeValue(«00:00:01»))
Call SendKeys(conw, True)
Application.Wait (Now + TimeValue(«00:00:02»))
conw = Empty
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «{TAB}»
‘ActiveWindow.Application.SendKeys «(~)»
Application.Wait (Now + TimeValue(«00:00:01»))
Call SendKeys(textw, True)
Application.Wait (Now + TimeValue(«00:00:01»))
ActiveWindow.Application.SendKeys «(~)» ‘énvia enter para enviar mensaje
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Descarga la macro Como Enviar Whatsapp a Grupos de WHATSAPP
Desde el final puedes descargar el ejemplo en forma gratuita, solicito aportar a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.
Código que se encuentra en el modulo 1
#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 GetWindowText Lib «user32» Alias «GetWindowTextA» (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare PtrSafe Sub keybd_event Lib «user32» (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Public Declare PtrSafe Function GetForegroundWindow Lib «user32» () 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 GetWindowText Lib «user32.dll» Alias «GetWindowTextA» (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Sub keybd_event Lib «user32» (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function GetForegroundWindow Lib «user32.dll» () As Long
#End If
Public conw, textw
Sub Muestra()
UserForm1.Show
End Sub
Sub EnviaWhatsapp()
‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********
If conw = Empty Or textw = Empty Then
MsgBox («Debe ingresar contacto y texto para enviar Whatsapp»), vbCritical, «AVISO»
Exit Sub
End If
‘mylinkwhatsapp = «https://api.whatsapp.com/send?phone=» & telwhatsapp & «&text=» & textwhatsapp
‘ActiveWorkbook.FollowHyperlink mylinkwhatsapp
Shell «C:\Users\MyNotebook\AppData\Local\WhatsApp\WhatsApp.exe»
Application.Wait (Now + TimeValue(«00:00:03»))
ActiveWindow.Application.SendKeys «{TAB}»
Application.Wait (Now + TimeValue(«00:00:01»))
Call SendKeys(conw, True)
Application.Wait (Now + TimeValue(«00:00:02»))
conw = Empty
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «{TAB}»
‘ActiveWindow.Application.SendKeys «(~)»
Application.Wait (Now + TimeValue(«00:00:01»))
Call SendKeys(textw, True)
Application.Wait (Now + TimeValue(«00:00:01»))
ActiveWindow.Application.SendKeys «(~)» ‘énvia enter para enviar mensaje
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Código que se encuentra en el userform1
Private Sub CommandButton1_Click()
conw = UserForm1.TextBox8
textw = UserForm1.TextBox1
Call EnviaWhatsapp
End Sub
Private Sub ListBox3_Click()
On Error Resume Next
ctlsaltachange = 1
UserForm1.TextBox8 = Empty
fila = UserForm1.ListBox3.ListIndex
UserForm1.TextBox8 = UserForm1.ListBox3.List(fila, 0)
UserForm1.TextBox9 = UserForm1.ListBox3.List(fila, 0) & » » & UserForm1.ListBox3.List(fila, 1) & » » & UserForm1.ListBox3.List(fila, 2)
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
ctlsaltachange = 0
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 ctlsaltachange = 1 Then Exit Sub
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 ‘» & a.Range(«A1») & «‘ ASC»
Set rs = cn.Execute(sql)
UserForm1.ListBox3.Clear
Set rs = cn.Execute(sql)
If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
UserForm1.ListBox3.Visible = False
Exit Sub
Else
UserForm1.ListBox3.ColumnCount = 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
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 3) = rs.Fields(4).Value
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 4) = rs.Fields(5).Value
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 5) = rs.Fields(6).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
‘El código 1 salta la programación del evento change del combobox16 porque sino cuando la macro modifica se vuelve a ejecutar y se obtiene resultado no deseado
‘saltacbo16 = 1
‘La macro al seleccionar el item autoaticamente ejecuta la programacion del evento click que es la busqueda del dato y que
‘es lo que interesa en esta programación, por eso no se llama luego al evento listbox_click sino se ejecuta dos veces.
UserForm1.ListBox3.Selected(0) = True
‘Call ListBox3_Click
UserForm1.ListBox3.Visible = False
‘Se hace perder el foco al combobox16, porque sino se ejecuta la codificación del After_Update
‘Userform1.TextBox2.SetFocus
End If
‘salir:
‘Vuelve la variable a estado 0 para que se pueda ejecutar el evento change con otro registro
‘saltacbo16 = 0
Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
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»
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
