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

 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

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.

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
 

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.

Editado el el 5 de abril1 año por Israel Cassales

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

Me parece muy interesante el trabajo que estás haciendo, de verdad.

Recomendaciones de VBA pues están algunos enlaces en la web, solo activa tu traductor de ser necesario

LEARN VBA

EXCEL VBA PROGRAMMING

INTRODUCCION A VBA