Es posible enviar imagen a whatsapp desde vba

Tengo este código el cual la función es enviar mensaje a whatsapp.

Al mismo necesito por favor de su ayuda para que pueda adjuntar una imagen y enviarla a destinatarios..

Quizás ustedes tengan un código ya armado..

Private Sub CommandButton1_Click()
Call wapp_texting
End Sub
Sub wapp_texting()
'Declaracion de variables
Dim text, contact As String ' Variables de envio
Dim i As Long 'Variable de itinerancia
Dim ws As Worksheet ' Variable de hoja de calculo
Dim wapp As Variant ' Variable de Applicacion
Set ws = Sheets("WAPP MENSAJERIA")
If Application.WorksheetFunction.CountA(ws.Range("B5:B1000000")) = 0 Then
    MsgBox "No hay numeros para enviar mensajes", vbOKOnly
    Exit Sub
End If
text = ws.Range("A2").Value
If text = "" Then
    If MsgBox("No ha introducido ningun mensaje. Quiere introducir uno ahora?", vbYesNo, "NO HAY MENSAJE PARA ENVIAR") = vbYes Then
        text = InputBox("Introduzca el mensaje", "MENSAJE A ENVIAR")
    Else
        MsgBox "No se ha podido enviar el mensaje"
        Exit Sub
    End If
End If
'Abre Chrome en la ventana de whatsapp web
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url https://web.whatsapp.com/") 'Cambiar esta linea si es necesario para encontrar Chrome
If MsgBox("Presione Si cuando Whatsapp este totalmente cargado y tenga activo Chrome todo el tiempo." & vbNewLine & vbNewLine & "Presione no si Whatsapp no abre en un tiempo considerable", vbYesNo, "Cargando Whatsapp") = vbNo Then
    MsgBox "No se envio nada..."
Else
    ' Inicia a cargar los mensajes
    Espera (6000)
    i = 0
    Do Until ws.Range("B5").Offset(i, 0) = ""
        Espera (3000)
        contact = ws.Range("B5").Offset(i, 0).Value
        Call SendKeys("{TAB}", True) ' Entra a la barra de busqueda
        Espera (2000)
        Call SendKeys(contact, True) ' Busca el numero de telefono
        Espera (2000)
        Call SendKeys("~", True) ' Entra a la barra de mensajes
        Espera (1000)
        Call SendKeys(text, True) ' Escribe el mensaje
        Espera (1000)
        Call SendKeys("~", True) 'Envia el mensaje
        i = i + 1
    Loop
MsgBox "Mensajes Enviados!" & vbNewLine & vbNewLine & "Revisa tu whatsapp para comprobar los resultados", vbOKOnly, "Fin del procedimiento"
Set ws = Nothing
End If
Shell "taskkill /IM chrome.exe /F"
End Sub
Function Espera(ByVal tiempo As Double)
' Espera en milisegundos
Application.Wait (Now() + tiempo / 24 / 60 / 60 / 1000)
End Function
Private Sub UserForm_Initialize()
End Sub