Código:
Declare PtrSafe 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
Const SW_NORMAL = 1 'Para optimizar la aplicación
Sub EnvioCartera()
Dim Rango As Range, Mensaje As String
'Inabilitar la pantalla
Application.ScreenUpdating = False
'Nombre de la tabla y columna
For Each Rango In Hoja1.Range("BD[Razón social]")
'indicativo + número + texto, utilizamos VBA.Replace para reemplazar los espacios por %20 porque para whatsapp el espacio es %20
Mensaje = VBA.Replace("whatsapp://send?phone=" & "57" & Rango.Offset(0, 6).Value & "&text=" & "Hola " & Rango.Value & " le escribimos para informarle que al día de hoy tenemos una factura pendiente por pagar " & Rango.Offset(0, 1).Value & " del día " & Rango.Offset(0, 2).Value & " con un saldo de " & Rango.Offset(0, 5).Value & ", agradecemos enviarnos el comprobante de pago para cruzar el saldo. Muchas Gracias.", " ", "%20")
'Para obtener el mensaje
x = ShellExecute(hwnd, "Open", Mensaje, &O0, &O0, SW_NORMAL)
'El caracter ~ es para presionar enter y enviar el mensaje
Application.Wait Now + TimeValue("00:00:04")
Call SendKeys("~", True)
'El caracter ~ es para presionar enter y enviar el mensaje
Call SendKeys("~", True)
'Para esperar 4 segundos la ejecucion
Application.Wait Now + TimeValue("00:00:04")
'El caracter ~ es para presionar enter y enviar el mensaje
Call SendKeys("~", True)
'Vaciar de nuevo la memoria
Application.CutCopyMode = False
'Volver la ventana
Windows(ThisWorkbook.Name).Activate
'Para esperar 2 segundos la ejecucion
Application.Wait Now + TimeValue("00:00:04")
Next Rango
Hoja1.Select
'Habilitar la pantalla
Application.ScreenUpdating = False
MsgBox ("Mensaje con Exito"), vbInformation
End Sub
