通过 whatsapp 从 excel 发送照片
send a pic from excel via whatsapp
我们如何通过 whatsapp 发送来自 excel 的照片？
我找到了 vba 代码，可以通过 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
尝试此代码并进行调整以适合您。在 A 列（phone 数字）和 B 列（link 您需要附加的图像）
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
我看到上面的代码不再有效，所以我尽力修复它。
一些注意事项：如果您使用其他语言的浏览器，请将“打开”替换为您的语言对应的单词，HTML中的附加图片按钮的位置有变化之前位于上面的whatsapp已经下降了，更多的是DIV'S, Spans，从".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 - Nova Era\PF\Arquivos\Imagem.png")
Call SendMessage(openRet, BM_CLICK, 0, 0)
End Sub
我们如何通过 whatsapp 发送来自 excel 的照片？
我找到了 vba 代码，可以通过 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
尝试此代码并进行调整以适合您。在 A 列（phone 数字）和 B 列（link 您需要附加的图像）
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
我看到上面的代码不再有效，所以我尽力修复它。
一些注意事项：如果您使用其他语言的浏览器，请将“打开”替换为您的语言对应的单词，HTML中的附加图片按钮的位置有变化之前位于上面的whatsapp已经下降了，更多的是DIV'S, Spans，从".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 - Nova Era\PF\Arquivos\Imagem.png")
Call SendMessage(openRet, BM_CLICK, 0, 0)
End Sub