excell üzerinden whatsapp toplu resim gönderme

[sevensuleyman]

watsapp kullarak toplu halde resim göndermek istiyorum. internetten bir kaç tane vba kodu buldum ama uyarlayamadım ustalarımdan yardım bekliyorum .





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







2. kod
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