Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL
Enviar Whatsapp con Excel

Como Enviar Imagenes en Whatsapp con Excel


.

Son varios los suscriptores del canal y foros que solicitaban el Envío de Imágenes o Fotos en Whatsapp desde Excel, pues bien en este ejemplo se muestra precisamente eso, Como Enviar Fotos en Whatsapp Desde Excel.

En este play list se muestran otros ejemplos relacionados con el Envío de Whatsapp desde Excel, suscribe al canal y solicita el ejemplo que te sea útil para automatizar tus hojas de Excel.

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.

  
Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.


if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}

 
En este ejemplo se muestra como seleccionar una imagen y enviarla por Whatsapp utilizando Excel, para lograr lo mencionado se necesita ingresar el número de teléfono al que se requiere enviar el Whatsapp, el texto a enviar y seleccionar la imagen que se requiere enviar; el texto a enviar no es necesario, pero si se ingresa aparecerá debajo de la imagen enviada.

Cuando se descarga el ejemplo se muestra un botón presionando el mismo muestra el formulario que permite ingresar el número de teléfono, luego el texto que en este caso no es obligatorio y la imagen a enviar.

Excel utiliza la API Oficial de Whatsapp para enviar el mensaje de Whatsapp a través de Excel, el requisito es que se debe tener Whatsapp WEB activado, para ello visita el sitio oficial de Whatsapp que te ayudará a activarlo; lo cual es muy fácil ya que ingresando al sitio muestra un código QR, tu debes ingresar a Whatsapp desde tu Smartphone luego a Ajustes luego a Whatsapp Web y escanear el código que se muestra en pantalla.

Se debe escribir en el Textbox8 que es el primer Textbox de la izquierda, se puede ingresar directamente el número sin el + o se puede escribir en el textbox del lado derecho para que busque en la base de datos haciendo click en el textbox emergente seleccionar el contacto.

Por defecto al mostrar el formulario se muestra un mensaje predeterminado a enviar, eso obvio que se puede modificar por el mensaje que se requiera enviar, este paso no es necesario si solo se requiere enviar la imagen sin ningún texto, en caso que se ingrese aparecerá debajo de la imagen enviada.

Posteriormente se debe seleccionar la imagen que se requiere enviar, seleccionando de un Explorador de Archivos de Windows que se muestra al presionar el botón con tres puntitos, la dirección se guarda en una variable pública que luego se usa en la macro.

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

Quizá sea de utilidad también

Como Enviar Whatsapp Desde Excel

Como Enviar Whatsapp en Forma Masiva con Excel

Como Enviar Whatsapp desde Excel en Forma Masiva Con Buscador de Contacto

Como Enviar Whatsapp Personalizados en Forma Masiva Desde Excel

Teniendo ya cargado los datos necesarios se debe presionar el botón con el símbolo de Whatsapp para enviar el mensaje desde Excel, este contiene el siguiente código:

Set imag = ActiveSheet.Pictures.Insert(direima)
‘UserForm1.Hide
With imag
.Copy
.Delete
End With
El código anterior  inserta la imagen seleccionada en la hoja de Excel haciendo un objeto con esa imagen, luego copia la imagen quedando en el portapapeles e inmediatamente la elimina, luego con los siguientes códigos carga en variable el número de teléfono y el mensaje, todas estás variables son públicas porque son usadas posteriormente en otro procedimiento, que es el que envía Whatsapp y es llamado con el código Call EnviaWhatsapp.
telwhatsapp = UserForm1.TextBox8
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp

En el módulo1 se encuentre la macro que envía el Whatsapp utiliza SenKey, que sirve para enviar un impulso que equivale a presionar una tecla, en primer lugar Excel navega hasta la URL de la API de Whatsapp WEB, enviando en la URL el Número y el Texto a enviar, con los siguientes códigos:

mylinkwhatsapp = «https://api.whatsapp.com/send?phone=» & telwhatsapp & «&text=» & textwhatsapp

ActiveWorkbook.FollowHyperlink mylinkwhatsapp

Con los códigos anteriores la macro ya habrá ingresado a la URL de la API de Whatsapp, luego se detiene la macro unos segundos para esperar que la página WEB se cargue, eso se hace con el siguiente código, en el ejemplo se espera 5 segundos, dependiendo de la rapidez que cada uno posea de internet puede disminuirse el tiempo a 2 o 3 segundos, esto se hace tanto en este como en el resto de los códigos donde se detiene la macro para esperar que se cargue bien la página:

Application.Wait (Now + TimeValue(«00:00:05»))

Luego se envía impulso, similar a presionar la tecla TABULADOR, se realiza dos veces, para pasar a otros objetos de la página y llegar hasta la tecla Send de la página Web de la API de Whatsapp
ActiveWindow.Application.SendKeys «{TAB}»

Application.Wait (Now + TimeValue(«00:00:01»))

ActiveWindow.Application.SendKeys «{TAB}»

Application.Wait (Now + TimeValue(«00:00:05»))

Luego se espera 5 segundos y se envía el impulso de la tecla Enter que hace enviar el Whatsapp, esperando en ese caso 18 segundos para que se carguen los Chats de Whatsapp, apareciendo el texto que se requiere enviar en el espacio destinado a tal fin en la Aplicación Web de Whatsapp 

ActiveWindow.Application.SendKeys «(~)» ‘envia enter para enviar mensaje

Application.Wait (Now + TimeValue(«00:00:18»))
Ahora se procede a copiar la imagen que se copio al principio de la macro y que se mantenía en el portapapeles, para ello se envía el impulso equivalente a presionar «Ctrl V», que sirve para pegar, el código es el siguiente:

ActiveWindow.Application.SendKeys «(^v)»

Pór último se envía los impulsos de teclado correspondiente a la tecla Enter, envía la imagen seleccionada y termina la macro, los códigos son los siguientes: 

ActiveWindow.Application.SendKeys «(~)»

Application.Wait (Now + TimeValue(«00:00:01»))

ActiveWindow.Application.SendKeys «(~)»

El código completo del ejemplo Como Enviar Imágenes o Fotos de Whatsapp con Excel se muestra a continuación, y posteriormente se encuentra el link para la descarga del archivo de ejemplo la cual es totalmente GRATIS, previamente considera la posibilidad de donar para que se puedan seguir agregando más ejemplos gratuitos.

Código que se inserta en un Formulario de Excel

‘**************https://macrosenexcel.com  **** https://youtube.com/programarexcel*********

Private Sub CommandButton1_Click()
‘*********** by marcrodos **** https://macrosenexcel.com  ***  https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********

Set imag = ActiveSheet.Pictures.Insert(direima)
‘UserForm1.Hide
With imag
.Copy
.Delete
End With
telwhatsapp = UserForm1.TextBox8
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
End Sub

Private Sub CommandButton2_Click()
direima = Application.GetOpenFilename(«Archivos JPG PNG BMP  (*.jpg*;*.png*;*.bmp*), *.jpg*;*.png*;*.bmp*»)
TextBox10 = direima
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, 1)
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 Nombre 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.Column = 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 programacion 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://macrosenexcel.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

Código que se inserta en un módulo

#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

#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

#End If

Public telwhatsapp, textwhatsapp, direima

Sub Muestra()

UserForm1.Show

End Sub

Sub EnviaWhatsapp()

Application.ScreenUpdating = False

Application.DisplayAlerts = False


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


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 «(^v)»

ActiveWindow.Application.SendKeys «(~)»

Application.Wait (Now + TimeValue(«00:00:01»))

ActiveWindow.Application.SendKeys «(~)»

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