Skip to main content

AccessTr.neT


Selenium İle Wahatsapp Yollama Pdf Olarak Ve Diğerleri.

Selenium İle Wahatsapp Yollama Pdf Olarak Ve Diğerleri.

#7
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.
Cevapla
#8
Büyük ihtimalle wsBot diye dim olarak tanımlanmamıştır.
Yada tanımlanıp set edilmemiştir.
Cevapla
#9
(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]


Son Düzenleme: 06/06/2021, 01:15, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#10
Kıdun tammını bir atın bakayım mobilden.
Cevapla
#11
(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 
[Resim: img-cray.gif]


Cevapla
#12
@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 
[Resim: img-cray.gif]


Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da