Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Envío de mensajes whatsapp desde excel

Pakus

Recommended Posts

Pakus Novato

Pakus

publicado
publicado

Buenas tardes a todos

Esta macro que os pongo a continuación envía un mensaje de texto y foto a una lista de teléfonos que le pongas en el Excel. Funciona perfectamente, el único inconveniente es que todos los teléfonos tienen que estar en la agenda, si algún teléfono no esta en la agenda se cuelga y deja de enviar.  ¿Hay alguna manera de hacer que si un numero no está en la agenda no haga nada y pase al siguiente numero?

Gracias por prestarme atención

La macro:

Sub EnvíoMensajesW2()
Dim Teléfono As String
Dim Imagen As String
Dim Texto As String

For Each Celda In Envío.Range("Clientes[TELÉFONO]")
    
        With Envío
            Teléfono = Celda.Value
            Texto = Celda.Offset(0, 6).Value
            Imagen = Celda.Offset(0, 7).Value
            .Pictures.Insert(Imagen).Name = "ImagenW"
            .Shapes("ImagenW").Copy
        
            AppActivate "WhatsApp"
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "^f", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys Teléfono, True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "{Tab}", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys Texto, True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "^v", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            .Shapes("ImagenW").Delete
        End With
    
Next Celda

End Sub

Israel Cassales Mentor

Israel Cassales

publicado
publicado

 Hi,

Una idea sería agregar una verificación al código con una función que valida si el número existe o no en la agenda, por otro ¿la agenda es una tabla de Excelo es la agenda del Windows? Podrías usar CountIf. 

Function ContactoEnAgenda(Tel As String) As Boolean
    ' Ejemplo:
    ' ContactoEnAgenda = (Application.WorksheetFunction.CountIf(Range("Agenda[TELÉFONO]"), Tel) > 0)
End Function

La función devuelve True si el número está en la agenda y False si no lo está.

Y en tu código dentro del bucle For Each la mandas llamar. 

' Verifica si el número está en la agenda antes de enviar
        If ContactoEnAgenda(Teléfono) Then
            With Envío
                .Pictures.Insert(Imagen).Name = "ImagenW"
                .Shapes("ImagenW").Copy

Es lo que podría sugerir

Pakus Novato

Pakus

publicado
  • Autor
publicado

Gracias por responder.

La agenda es la de Google,  que el whatsapp reconoce cuando introduces el numero. Voy a probar tu sugerencia a ver si la hago funcionar.

Pakus Novato

Pakus

publicado
  • Autor
publicado

No acaba de funcionar da error de compilación " se esperaba End Sub"

Quizás no he sabido implementarlo bien, lo pongo a continuación como me ha quedado:

Sub EnvíoMensajesW2()
Dim Teléfono As String
Dim Imagen As String
Dim Texto As String

Function ContactoEnAgenda(Tel As String) As Boolean
ContactoEnAgenda = (Application.WorksheetFunction.CountIf(Range("Agenda[TELÉFONO]"), Tel) > 0)
End Function

For Each Celda In Envío.Range("Clientes[TELÉFONO]")

        If ContactoEnAgenda(Teléfono) Then

        With Envío
            Teléfono = Celda.Value
            Texto = Celda.Offset(0, 6).Value
            Imagen = Celda.Offset(0, 7).Value
            .Pictures.Insert(Imagen).Name = "ImagenW"
            .Shapes("ImagenW").Copy
        
            AppActivate "WhatsApp"
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "^f", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys Teléfono, True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "{Tab}", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys Texto, True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "^v", True
            Application.Wait (Now + TimeValue("00:00:03"))
            SendKeys "~", True
            .Shapes("ImagenW").Delete
        End With
    
Next Celda

End Sub
 

Israel Cassales Mentor

Israel Cassales

publicado
publicado

Bueno la función es la clave en esta idea, por eso la pregunta de dónde la consultaba. Yo no tengo experiencia para pasar la credenciales de Google para verificar la agenda por esa razón te recomendaría una hoja de Excel que se llame por ejemplo Agenda de Google y que el rango esta en A:C, en A el número, en B el nombre y en C no sé, el puesto.

Debería quedar algo así: 

Function ContactoEnAgenda(Tel As String) As Boolean
    Dim Agenda As Range
    Dim Celda As Range
    
    ' Define el rango de la hoja "Agenda de Google" (ajusta el nombre de la hoja según corresponda)
    Set Agenda = Worksheets("Agenda de Google").Range("A:C")
    
    ' Busca el número de teléfono en la columna A
    For Each Celda In Agenda.Columns(1).Cells
        If Celda.Value = Tel Then
            ContactoEnAgenda = True
            Exit Function ' Sale de la función si encuentra el número
        End If
    Next Celda
    
    ' Si no se encuentra el número, devuelve False
    ContactoEnAgenda = False
End Function

Una vez creado lo anterior el código completo debería funcionar así: 

Sub EnvíoMensajesW2()
    Dim Teléfono As String
    Dim Imagen As String
    Dim Texto As String
    Dim WhatsAppApp As Object ' Variable para la aplicación de WhatsApp

    ' Abre WhatsApp si no está abierto
    On Error Resume Next
    Set WhatsAppApp = GetObject(, "WhatsApp.Application")
    On Error GoTo 0
    If WhatsAppApp Is Nothing Then
        Shell "C:\Program Files\WhatsApp\WhatsApp.exe", vbNormalFocus
        Application.Wait (Now + TimeValue("00:00:05")) ' Espera unos segundos para que WhatsApp se abra completamente
    End If

    For Each Celda In Envío.Range("Clientes[TELÉFONO]")
        Teléfono = Celda.Value
        Texto = Celda.Offset(0, 6).Value
        Imagen = Celda.Offset(0, 7).Value

        ' Verifica si el número está en la agenda de Google antes de enviar
        If ContactoEnAgenda(Teléfono) Then
            With Envío
                .Pictures.Insert(Imagen).Name = "ImagenW"
                .Shapes("ImagenW").Copy

                AppActivate "WhatsApp"
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "^f", True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys Teléfono, True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "{Tab}", True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "~", True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys Texto, True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "~", True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "^v", True
                Application.Wait (Now + TimeValue("00:00:03"))
                SendKeys "~", True
                .Shapes("ImagenW").Delete
            End With
        Else
            ' El número no está en la agenda de Google, pasa al siguiente
        End If
    Next Celda
End Sub

Function ContactoEnAgenda(Tel As String) As Boolean
    Dim Agenda As Range
    Dim Celda As Range
    
    ' Define el rango de la hoja "Agenda de Google" (ajusta el nombre de la hoja según corresponda)
    Set Agenda = Worksheets("Agenda de Google").Range("A:C")
    
    ' Busca el número de teléfono en la columna A
    For Each Celda In Agenda.Columns(1).Cells
        If Celda.Value = Tel Then
            ContactoEnAgenda = True
            Exit Function ' Sale de la función si encuentra el número
        End If
    Next Celda
    
    ' Si no se encuentra el número, devuelve False
    ContactoEnAgenda = False
End Function

Es lo que podría aportar. Haz pruebas a ver qué tal, también está la posibilidad de que algún usuario avanzado o Maestro aporte algo adicional.

Pakus Novato

Pakus

publicado
  • Autor
publicado

Muchas gracias por tu aporte Israel, te agradezco de verdad tu ayuda, pues todo esto es por trabajo.

Un empleo nuevo en el que llevo una semana, aunque no viene al caso esto ahora. Baste decir que esta orientado al marketing online y sus variantes.  Como agradecimiento por tu ayuda, y porque supongo que tienes curiosidad de para que es la macro, te lo cuento... espero no aburrirte.

En el trabajo he heredado una base de datos de clientes que esta desactualizada, por eso los problemas de números móviles que no están en la agenda, números que han cambiado o negocios que han cerrado. Tengo que ponerla al día, quitar la paja y tener un sistema efectivo de contacto con esos clientes para enviar el mismo mensaje a todos a la vez. 

Algunos clientes son muy antiguos (por eso los problemas de envio de WhatsApp). Con este sistema de envio los clientes activos están muy contentos, pero el proceso me obliga a estar atento cuando hago los envíos con la macro, pues si no, se cuelga. Si estoy atento, cuando la macro carga el movil que no esta en la agenda, con un par de clicks en el campo del contacto dentro de la ventana del WhatsApp puedo obviar el error y que siga trabajando la macro. 

¿Por que el error fastidia? porque la base de datos tiene 6.000 clientes (si, es un dinosaurio de c..j..s) y de estos hay unos 4.000 números de movil en toda España. Hago la macro por provincias, unos 300 envíos de mensajes a móviles uno detrás de otro. Como tarda unos 100 minutos mas o menos me obliga a estar ese tiempo muy atento a la pantalla para evitar el cuelgue y hacer los clicks oportunos... hazte una idea.

Voy a probar lo que sugieres y te cuento, ya será el lunes pq toda la tostada esta en la oficina donde trabajo, y es hora de disfrutar el fin de semana.

¿Podrías recomendarme libros, manuales o lo que sea para poder aprender mas de visual basic para aplicaciones? 

Yo tengo buenos conocimientos de html, paginas web, gestores de contenido y ese entorno, pero ando muy flojo en programación pura. Conozco el excel desde hace años, pero ahora que por primera vez he aterrizado en el Planeta VBA me siento como Jake Sully en sus primeros diez minutos pisando la selva de Pandora, si te acuerdas de esa escena en la peli :)

saludos

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 
    • JSDJSD
      Surtido de Mercancía

      Por JSDJSD · publicado

      Podrías compartir tu solucion

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.