通过whatsapp从excel发送图片 [英] send a pic from excel via whatsapp
本文介绍了通过whatsapp从excel发送图片的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我们如何通过whatsapp从excel发送图片?
How can we send a pic from excel via whatsapp?
我发现vba代码可以通过 https://web.whatsapp.com 发送邮件,
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
推荐答案
尝试以下代码并进行调整以适合您.在A列(电话号码)和B列(您需要附加的图片的链接)
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
这篇关于通过whatsapp从excel发送图片的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文