send a pic from excel via whatsapp

Question

How can we send a pic from excel via whatsapp?

I have found the vba code to send messages via https://web.whatsapp.com,

Sub Test()

    Dim text As String
    Dim contact As String
    text = Range("C2").Value
    ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"
    If MsgBox("Is WhatsApp Loaded?" & vbNewLine & vbNewLine & "Press No To Cancel", vbYesNo + vbQuestion + vbSystemModal, "WhatsApp") = vbYes Then
        Fazer (100)
        startrow = 2
        startcol = 2
        Do Until Sheets(1).Cells(startrow, 1) = ""
            contact = Cells(startrow, 1)
            text1 = Sheets(1).Cells(startrow, startcol).Value
            Fazer (3000)
                Call SendKeys("{TAB}", True)
            Fazer (1000)
                Call SendKeys(contact, True)
            Fazer (1000)
                Call SendKeys("~", True)
            Fazer (1000)
                Call SendKeys(text1, True)
            Fazer (1000)
                Call SendKeys("~", True)
            Fazer (1000)
            startrow = startrow + 1
        Loop
    Else
    End If
End Sub

Function Fazer(ByVal Acao As Double)
    Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)
End Function

YasserKhalil · Accepted Answer · 2020-06-14T20:44:57.780

Try this code and adjust to suit you. In column A (the phone numbers) and in column B (the link to the image you need to attach)

Private Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Dim strBuff As String, butCap As String
Public Const WM_SETTEXT = &HC
Public Const BM_CLICK = &HF5
Private bot As New Selenium.ChromeDriver

Sub SendMessageUsingWhatsApp()
    Dim arr, ws As Worksheet, b As Boolean, t As Date, ele As Object, JS_PROFILE As String, i As Long
    JS_PROFILE = "C:\Users\" & Application.UserName & "\AppData\Local\Google\Chrome\User Data\Default"
    Set bot = New ChromeDriver
    Set ws = ActiveSheet
    arr = ws.Range("A2:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
    With bot
        .AddArgument "--disable-popup-blocking"
        .SetProfile JS_PROFILE, True
        For i = LBound(arr) To UBound(arr)
            If Not IsEmpty(arr(i, 1)) Then
                .Get "https://web.whatsapp.com/send?phone=" & arr(i, 1)
                If b = False Then .Window.Maximize: b = True
                Application.Wait (Now + TimeValue("00:00:05"))
                If .FindElementsByXPath("//*[@id='app']/div/span[2]/div/span/div/div/div/div/div/div[1]").Count > 0 Then
                    Debug.Print "The Mobile " & arr(i, 1) & " Not Valid Number."
                    .FindElementByXPath("//*[@id='app']/div/span[2]/div/span/div/div/div/div/div/div[2]/div").Click
                    GoTo Skipper
                End If
                t = Timer
                Do
                    DoEvents
                    On Error Resume Next
                        Set ele = .FindElementById("main")
                    On Error GoTo 0
                    If Timer - t = 10 Then Exit Do
                Loop While ele Is Nothing
                Set ele = Nothing
                Application.Wait (Now + TimeValue("00:00:02"))
                    .FindElementByXPath("//*[@id='main']/header/div[3]/div/div[2]/div/span").Click
                    .FindElementByXPath("//*[@id='main']/header/div[3]/div/div[2]/span/div/div/ul/li[1]").Click
                Application.Wait (Now + TimeValue("00:00:02"))
                Call Sample(CStr(arr(i, 2)))
                Application.Wait Now + TimeValue("00:00:05")
                    .FindElementByCss("span[data-icon='send']").Click
                Application.Wait Now + TimeValue("00:00:05")
            End If
Skipper:
        Next i
    End With
    MsgBox "Done...", 64
End Sub

Sub Sample(sPic As String)
    Dim hw As Long, hw1 As Long, hw2 As Long, hw3 As Long, op As Long, openRet As Long
    hw = FindWindow(vbNullString, "Open")
    op = FindWindowEx(hw, 0&, "Button", vbNullString)
    strBuff = String(GetWindowTextLength(op) + 1, Chr$(0))
    GetWindowText op, strBuff, Len(strBuff)
    butCap = strBuff
    Do While op <> 0
        If InStr(1, butCap, "Open") Then openRet = op: Exit Do
    Loop
    hw1 = FindWindowEx(hw, 0&, "ComboBoxEx32", vbNullString)
    hw2 = FindWindowEx(hw1, 0&, "ComboBox", vbNullString)
    hw3 = FindWindowEx(hw2, 0&, "Edit", vbNullString)
    Call SendMessageByString(hw3, WM_SETTEXT, 0, ThisWorkbook.Path & "\Pics\(" & sPic & ").jpg")
    Call SendMessage(openRet, BM_CLICK, 0, 0)
End Sub

Which libraries need to add to execute above code because I have 64 bit system — Umar Farooq, Jun 18 '20 at 09:28
You need to install selenium for VBA. Have a look at this link https://stackoverflow.com/questions/57216623/ — YasserKhalil, Jun 18 '20 at 10:19
I am getting compile error it is written to update code for 64 bit, however, I will install selenium as per your guide link — Umar Farooq, Jun 18 '20 at 10:58
I am using Windows 64 Bit and Office 32 Bit and it is working well with me. — YasserKhalil, Jun 18 '20 at 11:11
Try using excel 32 Bit as the 64 version has a lot of problems. I was using it before but I faced many problems and didn't find a solution for such problems. — YasserKhalil, Jun 18 '20 at 13:04
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/216219/discussion-between-umar-farooq-and-yasserkhalil). — Umar Farooq, Jun 18 '20 at 13:55

score 0 · Answer 2 · answered Oct 05 '20 at 16:59

I saw that the code above was not working anymore, so I tried to fix it, to the best of my abilities.

Some points of attention: if you use the browser in another language replace the "Open" for the word corresponding to your language, there were changes in the location of the attach image button in the HTML of Whatsapp what was previously located above has gone down, more DIV'S, Spans, as can be seen in the syntax of ".FindElementByXPath"

Private Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Dim strBuff As String, butCap As String
Public Const WM_SETTEXT = &HC
Public Const BM_CLICK = &HF5
Private bot As New Selenium.ChromeDriver

Sub SendMessageUsingWhatsApp()
    Dim arr, ws As Worksheet, b As Boolean, t As Date, ele As Object, JS_PROFILE As String, i As Long
    JS_PROFILE = "C:\Users\" & Application.UserName & "\AppData\Local\Google\Chrome\User Data\Default"
    bot.Start "chrome"
    Set ws = ActiveSheet
    arr = ws.Range("A2:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
    With bot
        .AddArgument "--disable-popup-blocking"
        .SetProfile JS_PROFILE, True
        For i = LBound(arr) To UBound(arr)
            If Not IsEmpty(arr(i, 1)) Then
                .Get "https://web.whatsapp.com/send?phone=" & arr(i, 1)
                If b = False Then .Window.Maximize: b = True
                Application.Wait (Now + TimeValue("00:00:05"))
                If .FindElementsByXPath("//*[@id='app']/div/span[2]/div/span/div/div/div/div/div/div[1]").Count > 0 Then
                    Debug.Print "The Mobile " & arr(i, 1) & " Not Valid Number."
                    .FindElementByXPath("//*[@id='app']/div/span[2]/div/span/div/div/div/div/div/div[2]/div").Click
                    GoTo Skipper
                End If
                t = Timer
                Do
                    DoEvents
                    On Error Resume Next
                        Set ele = .FindElementById("main")
                    On Error GoTo 0
                    If Timer - t = 10 Then Exit Do
                Loop While ele Is Nothing
                Set ele = Nothing
                Application.Wait (Now + TimeValue("00:00:02"))
                    .FindElementByXPath("//*[@id='main']/footer/div[1]/div[1]/div[2]/div").Click
                    .FindElementByXPath("//*[@id='main']/footer/div[1]/div[1]/div[2]/div/span/div/div/ul/li[1]").Click
                Application.Wait (Now + TimeValue("00:00:02"))
                Call Sample(CStr(arr(i, 2)))
                Application.Wait Now + TimeValue("00:00:05")
                    .FindElementByCss("span[data-icon='send']").Click
                Application.Wait Now + TimeValue("00:00:05")
            End If
Skipper:
        Next i
    End With
    MsgBox "Done...", 64
End Sub

Sub Sample(sPic As String)
    Dim hw As Long, hw1 As Long, hw2 As Long, hw3 As Long, op As Long, openRet As Long
    hw = FindWindow(vbNullString, "Abrir")
    op = FindWindowEx(hw, 0&, "Button", vbNullString)
    strBuff = String(GetWindowTextLength(op) + 1, Chr$(0))
    GetWindowText op, strBuff, Len(strBuff)
    butCap = strBuff
    Do While op <> 0
        If InStr(1, butCap, "Abrir") Then openRet = op: Exit Do
    Loop
    hw1 = FindWindowEx(hw, 0&, "ComboBoxEx32", vbNullString)
    hw2 = FindWindowEx(hw1, 0&, "ComboBox", vbNullString)
    hw3 = FindWindowEx(hw2, 0&, "Edit", vbNullString)
    Call SendMessageByString(hw3, WM_SETTEXT, 0, "C:\Users\luiz_\Downloads\Backup PC\Trabalho\01 - Nova Era\PF\Arquivos\Imagem.png")
    Call SendMessage(openRet, BM_CLICK, 0, 0)
End Sub

send a pic from excel via whatsapp

2 Answers2

Linked