
COMO ENVIAR FICHEROS POR WHATSAPP CON UNA MACRO DE EXCEL
En este post se muestra como con una macro de Excel se puede enviar un archivo por Whatsapp, la macro permite seleccionar un contacto y enviarle un fichero determinado por Whatsapp, este el el c贸digo que se hab铆a prometido en el canal de You Tube que ser铆a liberado cuando se llegara a los 15 suscriptores, se llego聽 a eso y ac谩 les dejo el c贸digo, para que cada uno lo pueda descargar e implementarlo en alg煤n aplicaci贸n que tengan.
Maneja Excel como los mejores deber铆as hacer 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 un ARCHIVO POR WHATSAPP desde EXCEL con MACROS VBA
En el ejemplo que se puede descargar desde el final del post, se muestra como con una macro de Excel se puede Enviar un Archivo por Whatsapp en forma autom谩tica desde Excel VBA.
Se debe seleccionar en primer lugar, un contacto, eso se hace desde el formulario, seleccionado el contacto se proceder谩 a Enviar un fichero que est谩 predeterminado por medio de Whatsapp. Sugiero descargar el ejemplo y ver el v铆deo para que se entienda de forma m谩s f谩cil.
La macro manipula o mueve el puntero del mouse por medio de c贸digos y luego procede a hacer click en un lugar determinado en la aplicaci贸n Whasapp Web; en este caso se hace click en el buscador para buscar el contacto a enviar el archivo; luego聽 se posiciona el puntero del mouse, por supuesto manejado por c贸digo en forma autom谩tica; en el s铆mbolo para adjuntar archivo haciendo click con c贸digos, luego se aparece el explorador de archivos de Windows, donde se carga la direcci贸n de la macro a utilizar, posteriormente se sit煤a el mouse en el 铆cono para enviar el archivo y con sendkey se manda un impuso “Enter”, para enviar con Excel el archivo por Whatsapp.
Explicaci贸n del C贸digo para Poder Enviar Ficheros por Whatsapp usando Excel – VBA
Para que este ejemplo denominado como Enviar Ficheros por Whatsapp, manipular un poco las API de Windows, ya que necesitamos mover el Mouse con c贸digos VBA, como as铆 tambi茅n hacer que la ventana sea la ventana activa, para que al enviar impulsos de teclado con Sendkey no lo haga en un lugar incorrecto.
Se habr茅 la aplicaci贸n Whasapp Web, en ese momento se carga en una variable cual es nombre de la ventana activa y la procede a posicionar y darle un tama帽o predeterminado, esto es porque se necesita dejar fijo el lugar y tama帽o la ventana de Whatsapp Web, posteriormente hacerla activa, los c贸digos son los siguientes.
hwnd = Shell(“C:\Users\MyNotebook\AppData\Local\WhatsApp\WhatsApp.exe”, vbNormalFocus)
hwnd = FindWindow(vbNullString, “WhatsApp”) ‘Encuentro la ventana de Windows basada en su titulo.
hwnd = SetWindowPos(hwnd, HWND_TOP, 100, 100, 0, 0, SWP_NOSIZE)
SetForegroundWindow (hwnd) ‘activo ventana
Ac谩 viene lo importante y es lo que permite mover el mouse y hacer click en distintos lugares de la aplicaci贸n para poder enviar el Archivo por Whatsapp.
Las Coordenadas en la pantalla donde esta situado o se va a situar el mouse, se definen como x e y d谩ndonos la coordenada correcta de donde se sit煤a el mouse, el c贸digo es el siguiente:
SetCursorPos 250, 180 ‘posici贸n x e y
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Con el c贸digo anterior se procedi贸 a mover el mouse, hasta la secci贸n de b煤squeda de Whatsapp Web, luego se procede a esperar un segundo, pasado dicho lapso la contin煤a con la macro; se ingresar谩 por medio de sendkey, el nombre de la persona a quien enviaremos el archivo por Whatsapp, para luego esperar dos segundos para dar tiempo a la macro que realice la b煤squeda del contacto, los c贸digos usados son:
Application.Wait (Now + TimeValue(“00:00:01”))
Call SendKeys(conw, True)
Application.Wait (Now + TimeValue(“00:00:02”))
Luego de escribir el nombre del contacto, se procede a mover el mouse al lugar destinado para adjuntar archivos , que tiene como icono en Whatsapp Web, un clip, se hace luego Click y se muestran una serie de opciones para enviar, entre ellas est谩 la opci贸n para enviar archivos o fichero, se hace hace clik ahi, con estos c贸digos:
SetCursorPos 480, 580 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Luego se debe llevar el puntero del Mouse hasta el 铆cono que permite seleccionar que se va a adjuntar, en este caso adjuntaremos un archivo, se hace en el 铆cono previsto para ello y se hace click mediante c贸digo, mostrando el explorador de archivos de Windows, donde se debe seleccionar el a enviar; se usan los siguientes c贸digos:
Application.Wait (Now + TimeValue(“00:00:01”))
SetCursorPos 480, 400 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:02”))
Bien mostrado el Explorador de Archivos de Windows, se carga en la variable “nom”, es aqu铆 donde cada uno debe modificar para la direccio贸n de su archivo, para que funcione correctamente, se usa el siguiente c贸digo:
nom = “C:\Users\MyNotebook\Documents\AAMIS MACROS\Publicadas\Sigueme.pdf”
Posteriormente se guarda en el portapapeles o clipboard la direcci贸n obtenida en el paso anterior, de la siguiente forma:
objData.SetText nom
objData.PutInClipboard
Con el c贸digo siguiente, se pega lo que est谩 en el clipboard o portapepeles, que no es otra cosa que la direcci贸n del archivo que se desea enviar, esperando un segundo antes y uno segundo despu茅s, se utiliza sendkey para cerrar el explorador de archivos mostrando en Whatsapp Web el archivo a enviar.
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(^v)”
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(~)”
Application.Wait (Now + TimeValue(“00:00:01”))
Seleccionada la imagen y cerrado el explorador de archivos la como se dijo en el p谩rrafo anterior, la imagen seleccionada se mostrar谩 en Whatsapp Web, luego se debe mover el puntero del mouse, con c贸digo nuevamente, en este caso se posiciona en el icono que permite enviar el mensaje, posicionado el mouse correctamente se procede a enviar un un impulso de teclado con sendkey que procede a enviar el archivo de Whatsapp desde Excel, el c贸digo usado es el siguiente:
SetCursorPos 675, 455 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(~)”
Por 煤ltimo se agranda la ventana de Whatsapp Web al tama帽o que ten铆a originalmente, as铆:
hwnd = SetWindowPos(hwnd, HWND_TOP, 100, 100, 600, 600, SWP_NOSIZE)
C贸digo que permite Enviar Archivos en Whatsapp a trav茅s de Excel VBA
C贸digo que se coloca en un m贸dulo de VBA
#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
Option Explicit
‘es para el mouse
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
‘termina lo del mouse
Public Const HWND_TOP = 0
Public Const SWP_NOSIZE = &H40
Public conw, textwhatsapp
‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********
Sub Muestra()
UserForm1.Show
End Sub
Sub EnviaWhatsapp()
On Error Resume Next
‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********
Dim mylinkwhatsapp As String, hwnd As LongPtr, nom As String
Dim objData As New MSForms.DataObject
‘Dim hwnd As LongPtr
If conw = Empty Then
MsgBox (“Debe ingresar contacto de Whatsapp”), vbCritical, “AVISO”
Exit Sub
End If
hwnd = Shell(“C:\Users\MyNotebook\AppData\Local\WhatsApp\WhatsApp.exe”, vbNormalFocus)
hwnd = FindWindow(vbNullString, “WhatsApp”) ‘Encuentro la ventana de Windows basada en su titulo.
hwnd = SetWindowPos(hwnd, HWND_TOP, 100, 100, 0, 0, SWP_NOSIZE)
SetForegroundWindow (hwnd) ‘activoventana
SetCursorPos 250, 180 ‘posici贸n x e y
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:01”))
Call SendKeys(conw, True)
Application.Wait (Now + TimeValue(“00:00:02”))
SetCursorPos 480, 580 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:01”))
SetCursorPos 480, 400 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:02”))
nom = “C:\Users\MyNotebook\Documents\AAMIS MACROS\Publicadas\Sigueme.pdf”
objData.SetText nom
objData.PutInClipboard
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(^v)”
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(~)”
Application.Wait (Now + TimeValue(“00:00:01”))
SetCursorPos 675, 455 ‘x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue(“00:00:01”))
ActiveWindow.Application.SendKeys “(~)”
hwnd = SetWindowPos(hwnd, HWND_TOP, 100, 100, 600, 600, SWP_NOSIZE)
End Sub
聽
C贸digo que va en un formulario
Private Sub CommandButton1_Click()
conw = UserForm1.TextBox8
textw = UserForm1.TextBox1
‘Unload UserForm1
‘Application.WindowState = xlMinimized
Call EnviaWhatsapp
‘Application.WindowState = xlMaximized
MsgBox (“El archivo se envi贸 con 茅xito”), vbInformation, “AVISO”
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 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://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
Puedes DESCARGAR el Ejemplo usado para Enviar Archivos de Whatsapp con Excel, haciendo click en los links siguientes.
Descarga el fichero usado como ejemplo en este post y en el v铆deo explicativo, el mismo es totalmente gratuito y libre su uso, solicito aportar para sostener esta web, si est谩 dentro de tus posibilidades, desde ya muchas gracias.
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
👉⏩ Cuenta Skrill: marcrodos@yahoo.es
👉⏩ Cuenta Neteller: marcrodos@yahoo.es
👉⏩ Apoya mi trabajo https://www.patreon.com/programarexcel
👉⏩ S铆gueme en DTube: https://d.tube/#!/c/programarexcel01
👉⏩ S铆gueme en Odysee: https://odysee.com/@programarexcel:3