Search code examples
excelvbaattachmentwhatsappsendkeys

send a pic from excel via whatsapp


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

Solution

  • 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