Enviar Masivamente Whatsapps desde Excel y Cerrar Chrome
Anteriormente se mostró una Macro de Excel que responde al requerimiento de Como Enviar Whatsapp en forma MASIVA desde Excel Nueva Versión, esta macro utiliza la API oficial de Whatsapp para poder enviar los mensajes de Whatsapp desde Excel, perso sucede que por cada envío va creando una nueva hoja de Chrome, por ende en este post se muestra como cerrar la ventana de Chrome al enviar Whatsapp masivos con Excel VBA.
Se un experto manejando excel, 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 a Grupo de Whatsapp con Excel
Para poder enviar un mensaje de Whatsapp a un grupo de Whatsapp con una macro de Excel, se debe abrir el libro de ejemplo presionar el botón que se encuentra en la hoja, se muestra un formulario, donde se puede seleccionar el grupo al cual se le requiere enviar el mensaje de whatsapp desde Excel y el texto a Enviar.
Luego la macro buscará abrirá aplicativo de Whatsapp que se encuentra instalado en la PC buscará el grupo y se le enviará el mensaje de Whatsapp al Grupo desde Excel.
Explicación de la macro que Enviar Whatsapp a Grupo de Whatsapp con Excel
La macro obtiene los valores de las variable conw y textw que contienen el nombre del grupo y el texto del mensaje, esto se extaer del userform de los textbox destinados al nombre del grupo y el mensaje, la macro verifica que dichas variables tengan valores sino detiene la macro.
If conw = Empty Or textw = Empty Then
MsgBox («Debe ingresar contacto y texto para enviar Whatsapp»), vbCritical, «AVISO»
Exit Sub
End If
Posteriormente con el comando Shell se ejecuta Whatsapp Web que está instalado en nuestra PC, se usa el siguiente código:
Shell «C:\Users\MyNotebook\AppData\Local\WhatsApp\WhatsApp.exe»
Iniciado el programa procede a enviar simulación de teclado con SendKey a los fines de buscar el grupo y escribir el mensaje, enviando en mensaje de Whatsapp al grupo se usan los siguientes códigos.
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
Quizás también interese leer:
Como Buscar por Cliente Rango de Fechas y Totalizar en Formulario
Como Buscar por Cliente Rango de Fechas y Totalizar en Listbox
Como Filtrar por Cliente Rango de Fechas e Imprimir Reporte
Descarga del código del aplicativo Enviar Whatsapp desde Excel a Grupo de Whatsapp
Te invito a descargar el ejemplo y adaptarlo a tus necesidades, desde el final del pos lo podrás hacer en forma gratuita del link de descarga, 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 Envío Whatsapp a Grupo de Whatsapp
#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
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 Formulario que Envía Whatsapp a Grupo de Whatsapp
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, 0)
End If
Next x
conta = 0
For Each dato In Num
conta = conta + 1
conw = dato
textw = 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 = 1
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