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

1 2 3 4

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.

Büyük ihtimalle wsBot diye dim olarak tanımlanmamıştır.
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.

Kıdun tammını bir atın bakayım mobilden.

(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

@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ı.

1 2 3 4