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

回答1:

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

来源：https://stackoverflow.com/questions/62371366/send-a-pic-from-excel-via-whatsapp

标签

excel

vba

attachment

sendkeys