Excel VBA 发送短信到 Whatsapp

Question

我设计了一个代码，可以将消息从 excel 发送到 WhatsApp 到联系人列表，它适用于单个联系人，但是当添加多个联系人时，它不会移动到该联系人而是将其他联系人姓名和消息粘贴到第一个联系人的消息框中。这是 excel 视图，当我按下按钮时，Whatsapp 网页的输出确实如图片所示那样工作。

我知道有一些小错误，但对于解决此问题的任何支持将不胜感激。这是代码

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

Answer 1

代码没有错误，WhatsApp Web 的工作方式不同：

在 Whatsapp 中发送消息后，需要两次 Tab 键才能进入搜索联系人的字段（第一个 Tab 将悬停在您刚刚发送的消息上). 这适用于第一次迭代后程序的每次迭代。

如果您不发送任何消息或只是打开 WhatsApp 网页版（您可能已经测试过），它只需要一次 Tab 键击。 这仅适用于循环的第一次迭代，但目前包含在每次迭代中。

在脚本中更改此设置的最简单方法是在发送文本后在循环中添加另一行以模拟第二次必要的击键。

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
    Fazer (1000)
       Call SendKeys("{TAB}", True) 'Simulate the 2nd keystroke
Loop

Answer 2

您也可以使用 WhatsApp API 并避免打开 wpp 网页（在 ActiveWorkbook.FollowHyperlink 地址:=" https://web.whatsapp.com/"），很多“sendkeys”和“wait”方法。

下载：

https://www.whatsapp.com/download

将 InternetExplorer 和 API 与您的 phone “已加载”一起使用，phone 号码的 link 不应包含特殊字符（查看文档）

看这个简单的例子：

Sub wpp()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application") 'Create object IE
    IE.navigate "whatsapp://send?phone=5511912341234&text=something" 'Send message "something" to this phone (Brazil)
    Application.Wait Now() + TimeSerial(0, 0, 3) 'ok just one wait and sendkeys :v
    SendKeys "~"
    'IE.Quit 'The navigate already kills the IE
    Set IE = Nothing 'Clear the object
End Sub

Excel VBA 发送短信到 Whatsapp

Excel VBA to send text message to Whatsapp

excel

vba

whatsapp

sendkeys