Tamam abey müsait olunca bakarım.Fotodan gördüğüm kadarıylada zaten cells yazan yerlerin başına sayfa adları yazılmalı garanti olsun diye.
Selenium İle Wahatsapp Yollama Pdf Olarak Ve Diğerleri.
Büyük ihtimalle wsBot diye dim olarak tanımlanmamıştır.
Yada tanımlanıp set edilmemiştir.
Yada tanımlanıp set edilmemiştir.
(06/06/2021, 01:11)feraz yazdı: Büyük ihtimalle wsBot diye dim olarak tanımlanmamıştır. .wsBot kısmını silip denediğinizdede hata verecekmi.Eğer en üstte option explicit gibi kod varsa zaten tanımlamak mecbur olur .explicit kısmı hatalı yazmış olabilirim kafadan.
yok feraz hocam tanımlama mecburi değil. Option Explicit yazılmamış.
(06/06/2021, 01:14)Oğuz Türkyılmaz yazdı:(06/06/2021, 01:11)feraz yazdı: Büyük ihtimalle wsBot diye dim olarak tanımlanmamıştır. .wsBot kısmını silip denediğinizdede hata verecekmi.Eğer en üstte option explicit gibi kod varsa zaten tanımlamak mecbur olur .explicit kısmı hatalı yazmış olabilirim kafadan.
yok feraz hocam tanımlama mecburi değil. Option Explicit yazılmamış.
Dim wsBOT As Worksheet şeklinde tanımlama var.
Access Çekirgesi
![[Resim: img-cray.gif]](https://www.accesstr.net/images/smilies/img-cray.gif)
Son Düzenleme: 06/06/2021, 01:15, Düzenleyen: Oğuz Türkyılmaz.
(06/06/2021, 01:16)feraz yazdı: Kıdun tammını bir atın bakayım mobilden.
Kod:
Dim WshShell As Object
Dim txtinputfield As String
Dim upload_media_btn As String
Dim upload_document_btn As String
Dim send_attachment_btn As String
Dim attach_btn As String
Dim searchinputfield As String
Dim add_caption As String
Dim no_contact_found As String
Dim link As String
Dim messagevalue As String
Dim messagetype As String
Dim invalid_number As String
Dim strFileExists As String
Dim strFileName As String
Dim send_method As String
Dim searchtext As String
Dim file_check As String
Dim textmessage_arr As Variant
Dim len_of_arrary As Integer
Dim file_size_bytes As Long
Dim file_size_mb As Long
Dim Line As Integer
Dim count_A As Long
Dim count_B As Long
Dim count_C As Long
Dim delayvalue As Long
Dim randomNumber As Integer
Dim Whatsap As New WebDriver, By As New By
Dim ks As New Keys
Dim lastrow_status As Long
Dim lastrow_a As Long
Dim lastrow_b As Long
Dim i As Long
Dim DELAY_TIME As Integer
Dim imagecaption As String
Dim random_number As Integer
Dim random_number_min As Integer
Dim random_number_max As Integer
Dim wb As Workbook
Dim wsBOT As Worksheet
Dim wsSettings As Worksheet
Public Enum BotColumn
wcNumber = 1 ' col A
wcText = 2 ' col B
wcType = 3
wcCaption = 4
wcStatus = 5
End Enum
Sub WhatsApp_BOT()
'SOURCE: Sven from 'Coding is Fun'
'YouTube Channel: https://www.youtube.com/c/CodingIsFun
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Activate Selenium Type Library: Tool > References
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set wb = ThisWorkbook
Set wsBOT = wb.Worksheets("Whatsap")
Set wsSettings = wb.Worksheets("AyarlarWhatsap")
Set WshShell = CreateObject("WScript.Shell")
Application.ScreenUpdating = True
'SET TIMEOUTS
Whatsap.Timeouts.ImplicitWait = 150000 'Default 3000
Whatsap.Timeouts.PageLoad = 150000 'Default 60000
Whatsap.Timeouts.Server = 150000 'Default 90000
'Whatsap ARGUMENTS
Whatsap.AddArgument "--disable-popup-blocking"
Whatsap.AddArgument "--disable-notifications"
'X_PATH_SETTINGS
txtinputfield = wsSettings.Range("txtinputfield").Value
upload_media_btn = wsSettings.Range("upload_media_btn").Value
upload_document_btn = wsSettings.Range("upload_document_btn").Value
send_attachment_btn = wsSettings.Range("send_attachment_btn").Value
attach_btn = wsSettings.Range("attach_btn").Value
searchinputfield = wsSettings.Range("searchinputfield").Value
add_caption = wsSettings.Range("add_caption").Value
invalid_number = wsSettings.Range("invalid_number").Value
no_contact_found = wsSettings.Range("no_contact_found").Value
'DELAY TIME SETTINGS
DELAY_TIME = wsBOT.Range("DELAY_TIME").Value * 1000 'in seconds
If IsEmpty(DELAY_TIME) = True Then
DELAY_TIME = 0
End If
lastrow_status = wsBOT.Cells(Rows.Count, BotColumn.wcStatus).End(xlUp).Row
lastrow_a = wsBOT.Cells(Rows.Count, BotColumn.wcNumber).End(xlUp).Row
lastrow_b = wsBOT.Cells(Rows.Count, BotColumn.wcText).End(xlUp).Row
'CHECK IF ALL FIELDS HAS BEEN FIELD OUT
count_A = wsBOT.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
count_B = wsBOT.Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
count_C = wsBOT.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).Count
If count_A <> count_B Or count_B <> count_C Or count_A <> count_C Then
MsgBox "Lütfen Sütundaki tüm gerekli alanları doldurun A,B & C"
Exit Sub
End If
'CHECK IF FILES EXITS & DOES NOT EXCEED 64MB
file_check = wsBOT.Range("file_check")
If file_check = "Yes" Then
For i = 2 To lastrow_b
messagevalue = wsBOT.Cells(i, BotColumn.wcText).Value
messagevalue = Replace(messagevalue, """", "")
messagetype = wsBOT.Cells(i, BotColumn.wcType).Value
If messagetype = "Media" Or messagetype = "Document" Then
On Error Resume Next
strFileExists = Dir(messagevalue)
If strFileExists = "" Or messagevalue = "" Then
MsgBox i & " .Satirdaki Dosya Bulunamadi. Program kapatilacak." _
& vbCrLf & _
"Doğru dosya yolunu girdiniz, ancak bu mesaj kutusu görünüyor? Hücrede bu denetimi devre dışı bırakabilirsiniz: Yani H16 dakini No Yap" & _
wb.Names("file_check").RefersTo, vbOKOnly, "Dosya Bulunamadi!"
GoTo var
End If
On Error GoTo 0
'CHECK FILE SIZE
file_size_bytes = FileLen(messagevalue)
file_size_mb = Round(file_size_bytes / 1000000, 0)
If file_size_mb >= 64 Then
MsgBox "Hücredeki " & i & " 64 MB boyutuni asti. Programdan cikilacak.", vbOKOnly, "Büyük Dosya Hatasi"
Exit Sub
End If
End If
var:
Next i
End If
'CLEAR STATUS
If lastrow_status <> 1 Then
wsBOT.Range(Cells(2, BotColumn.wcStatus), Cells(lastrow_status, BotColumn.wcStatus)).ClearContents
End If
'GET SEND METHOD (VIA API OR SEARCHBOX)
send_method = wsBOT.Range("send_method").Value
'SET USER PROFILE [AVOID SCANNNING QR CODE]
Whatsap.SetProfile Environ("Temp") & "\Selenium\scoped_dir11208_537850784\Default"
'Init New Chrome instance & navigate to WebWhatsApp
Whatsap.Start "chrome", "https://web.whatsapp.com/"
Whatsap.Get "/"
'Ask user to scan the QR code. Once logged it, continue with the macro
'MsgBox "Please scan the QR code. After you are logged in, please confirm this message box by clicking 'ok'"
'Go to each link, paste text into WebWhatsApp and press enter to send the message
For i = 2 To lastrow_a
'Include random delay time between messages
If wsBOT.Range("random_delay").Value = "Yes" Then
random_number_min = wsBOT.Range("random_delay_min").Value * 1000 'in milliseoncs
random_number_max = wsBOT.Range("random_delay_max").Value * 1000 'in milliseoncs
random_number = Int(random_number_min + Rnd * (random_number_max - random_number_min + 1))
Whatsap.Wait (random_number) 'in milliseconds
End If
messagevalue = wsBOT.Cells(i, BotColumn.wcText).Value
messagetype = wsBOT.Cells(i, BotColumn.wcType).Value
imagecaption = wsBOT.Cells(i, BotColumn.wcCaption).Value
If send_method = "Searchbox" Then
'---OPTION: USE SEARCHBOX (ONLY FOR SAVED CONTACTS [faster option])
Whatsap.FindElementByXPath(searchinputfield).WaitDisplayed(True).Click
Whatsap.Wait (500)
'Insert searchtext (phone number / or name)
searchtext = wsBOT.Cells(i, BotColumn.wcNumber).Value
Whatsap.SendKeys (searchtext)
Whatsap.Wait (500)
Whatsap.SendKeys (ks.Enter)
Whatsap.Wait (500)
'Check, if contact exists. If not, skip to the next record
If Whatsap.IsElementPresent(By.XPath(no_contact_found)) Then
Whatsap.FindElementByXPath(searchinputfield).Clear
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Hata: Kontakt bulunamadi " & Format(Now, "mm/dd/yyyy HH:mm:ss")
GoTo NextIteration
End If
ElseIf send_method = "API Link" Then
link = "https://web.whatsapp.com/send?phone=" & wsBOT.Cells(i, BotColumn.wcNumber)
Whatsap.Get link
On Error GoTo Handler
Handler:
If Err.Number = 26 Then
Whatsap.SwitchToAlert.Accept
Whatsap.Wait (6000)
On Error GoTo -1
End If
Continue:
'Wait Until search input field is visible
Whatsap.FindElementByXPath(searchinputfield).WaitDisplayed (True)
Whatsap.Wait (1000)
'Check if number is valid of not
'If number is not valid, error message will pop up
'If no error message, continue with the script otherwise skip iteration
If Whatsap.IsElementPresent(By.XPath(invalid_number)) Then
Whatsap.FindElementByXPath(invalid_number).Click
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Hata: Hatali Numara " & Format(Now, "mm/dd/yyyy HH:mm:ss")
GoTo NextIteration
End If
End If
If messagetype = "Text" Then
Call SendTextmessage(messagevalue)
ElseIf messagetype = "Media" Or messagetype = "Document" Then
Call SendAttachment(messagetype, messagevalue, imagecaption)
End If
NextIteration:
Next i
Whatsap.Quit
MsgBox "Bitti :)", vbOKOnly, "Basarili!"
End Sub
Sub SendTextmessage(messagevalue As String)
On Error GoTo ErrorHandler
'Split Textmessage baseed on "|" to identify new line
textmessage_arr = Split(messagevalue, "|")
'Length of variable. If only only line, it returns 1
len_of_arrary = UBound(textmessage_arr) - LBound(textmessage_arr) + 1
'Loop over array and press Shift + Enter to Create New Line in WebWhatsApp
For Line = LBound(textmessage_arr) To UBound(textmessage_arr)
Whatsap.FindElementByXPath(txtinputfield).WaitDisplayed (True)
Whatsap.FindElementByXPath(txtinputfield).SendKeys (textmessage_arr(Line))
Whatsap.Wait (500)
' Create a new line by pressing Shift & Enter
Whatsap.Keyboard.KeyDown (ks.Shift)
Whatsap.SendKeys (ks.Enter)
Whatsap.Keyboard.KeyUp (ks.Shift)
Whatsap.Wait (500)
Next Line
Whatsap.SendKeys (ks.Enter)
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Yollandi: " & Format(Now, "mm/dd/yyyy HH:mm:ss")
Whatsap.Wait (DELAY_TIME)
Exit Sub
ErrorHandler:
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Hata: " & Err.Number & "_" & Err.Description & ", " & Format(Now, "mm/dd/yyyy HH:mm:ss")
End Sub
Sub SendAttachment(messagetype As String, messagevalue As String, imagecaption As String)
On Error GoTo ErrorHandler
Dim pdfDosya As String
messagevalue = Replace(messagevalue, """", "")
' Check file size in MB (round up).
' Use Filesize as Delay Time before moving on to next file
file_size_bytes = FileLen(messagevalue)
file_size_mb = Application.WorksheetFunction.RoundUp(file_size_bytes / 1000000, 0)
Whatsap.FindElementByXPath(attach_btn).Click
' wsBOT.Range("B" & i).Copy
pdfDosya = wsBOT.Range("B" & i).Value
If messagetype = "Media" Then
Whatsap.FindElementByXPath(upload_media_btn).WaitDisplayed(True).Click
ElseIf messagetype = "Document" Then
Whatsap.FindElementByXPath(upload_document_btn).WaitDisplayed(True).Click
End If
Whatsap.Wait (2000)
'Paste Link to File via VBA
WshShell.SendKeys pdfDosya
Whatsap.Wait (2000)
Application.SendKeys ("{Enter}"), True
Whatsap.Wait (DELAY_TIME)
'Send Caption
If messagetype = "Media" Then
If imagecaption <> "" Then
Whatsap.FindElementByXPath(add_caption).WaitDisplayed(True).SendKeys (imagecaption)
Whatsap.Wait (300)
End If
End If
Whatsap.FindElementByXPath(send_attachment_btn).WaitDisplayed(True).Click
'Increase Delay Time depending on filesize.
'E.g. Filesize of 1 MB -> Increase of Delay time 500 ms (1 * 500)
Whatsap.Wait (DELAY_TIME + (file_size_mb * 500))
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Yollandi: " & Format(Now, "mm/dd/yyyy HH:mm:ss")
' Application.CutCopyMode = False
Exit Sub
ErrorHandler:
wsBOT.Cells(i, BotColumn.wcStatus).Value = "Hata: " & Err.Number & "_" & Err.Description & ", " & Format(Now, "mm/dd/yyyy HH:mm:ss")
' Application.CutCopyMode = False
End Sub
Access Çekirgesi
@feraz hocam bu orjinal dosyayı hiç kendi dosyama uyarlamakla uğraşmasam da Sadece kendi orjinal dosyamın whatsapp gönderme sayfasındaki numaraları bir şekilde bu uygulamaya köprü yada bağ yapıştır gibi bir çözümle kopyalamayız mı.
Access Çekirgesi
Konuyu Okuyanlar: 1 Ziyaretçi
