Selenium Basic ile Whatsapp mesajı göndermek.

serif_007

Altın Üye
Katılım
5 Nisan 2014
Mesajlar
155
Excel Vers. ve Dili
Excel 2019
Altın Üyelik Bitiş Tarihi
16-07-2027
Arkadaşlar merhaba.

Selenium ile kendi hazırlamış olduğum bir tablodaki verileri hangi satırdakini göndermek istediğimi seçerek gönderebileceğim bir çalışma yaptım. Fakat bir sorunum var. Mesaj gönderimini tamamladıktan sonra chrome'u kapatıyor ve her seferinde QR kodunu okutmadan giremiyorum. Kodları aşağıda paylaşıyorum. Nasıl bir değişiklik ile bu sorunun önüne geçebiliriz?
Yardımlarınızı rica ediyorum.

Kod:
Private Sub ListBox1_Click()


Function zaman(ByVal Acao As Double)

Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)


End Function

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
TextBox1.Enabled = True
TextBox1.BackColor = &H8000000E
Else
TextBox1.Enabled = False
TextBox1.BackColor = &HE0E0E0
End If
End Sub

Private Sub CheckBox2_Click()
Dim s As Integer
If CheckBox2.Value = True Then

For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = True
Next s
Else
For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = False
Next s
End If
End Sub


Private Sub CommandButton5_Click()

Dim baglan As New Selenium.WebDriver
Dim ks As New Keys
Dim Mesaj(20) As String


Basa:

baglan.Start "chrome", "https://web.whatsapp.com/"
baglan.Get "/"



If MsgBox("WhatsApp web Başladı MI?", vbYesNo) = vbYes Then  ' Bu soruyu ekrana soruyor önce whatsapp açıp daha sonra EVET denmelidir.

    GrupAdi = Sheets("MANEVRA KAYITLARI").Range("U2").Value   ' Whatsapp gönderilecek grup adının yazılması Denizli İşletme gibi

   'Mesaj = Sheets(1).Range("a2").Value  ' Gönderilecek mesajın metninin yer aldığı hücre
       
       
    For x = 0 To ListBox1.ListCount - 1

         If ListBox1.Selected(x) Then
         



If CheckBox1.Value = True Then
Call SendKeys(TextBox1.Value, True)
Else
Mesaj(1) = "İstasyon Adı: " & ListBox1.List(x, 3)
Mesaj(2) = "Fider Adı: " & ListBox1.List(x, 5)

Mesaj(4) = "Açma Saati: " & Format(ListBox1.List(x, 8), "hh:mm")
Mesaj(5) = "Kapama Saati: " & Format(ListBox1.List(x, 9), "hh:mm")
Mesaj(6) = "Arıza Sinyali: " & ListBox1.List(x, 12)
Mesaj(7) = "Açıklama: " & ListBox1.List(x, 13)

    baglan.FindElementByXPath("//*[@id='side']/div[1]/div/label/div/div[2]").Click
    baglan.Wait (1000)
    baglan.SendKeys (GrupAdi)
    baglan.Wait (1000)
    baglan.SendKeys (ks.Enter)
    baglan.Wait (1000)
    baglan.SendKeys (Mesaj(1))
    baglan.Wait (1000)
    SendKeys String:="%{enter}"
    baglan.Wait (1000)
    baglan.SendKeys (Mesaj(2))
    baglan.Wait (1000)
        SendKeys String:="%{enter}"
    baglan.Wait (1000)
        baglan.SendKeys (Mesaj(4))
    baglan.Wait (1000)
        SendKeys String:="%{enter}"
    baglan.Wait (1000)
        baglan.SendKeys (Mesaj(5))
    baglan.Wait (1000)
        SendKeys String:="%{enter}"
    baglan.Wait (1000)
    baglan.SendKeys (Mesaj(6))
    baglan.Wait (1000)
        SendKeys String:="%{enter}"
    baglan.Wait (1000)
        baglan.SendKeys (Mesaj(7))
    baglan.Wait (1000)
   
   
   
    baglan.SendKeys (ks.Enter)
    baglan.Wait (1000)
   
    End If
       
         End If
       
         Next x

         End If

UserForm2.Hide



End Sub

Private Sub OptionButton2_Click()
UserForm2.Caption = "Whatsapp Mesaj Gönder"
CommandButton5.Caption = "GÖNDER"
CheckBox2.Caption = "Tümünü Seç"
CheckBox1.Caption = "Mesaji Gönder"
End Sub

Private Sub UserForm_Initialize()
  TextBox1.Enabled = False
    ListBox1.ColumnCount = 21
    ListBox1.ColumnWidths = "100;100;100"
    ListBox1.ListStyle = fmListStyleOption
   ListBox1.MultiSelect = fmMultiSelectMulti
    ListBox1.RowSource = "A1:U" & [A65532].End(3).Row
      OptionButton2 = True

End Sub
 
Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Kodları çalıştırmadan önce bir tane kendiniz WhatsApp Web sayfası açın sonra kodları çalıştırın.
 

serif_007

Altın Üye
Katılım
5 Nisan 2014
Mesajlar
155
Excel Vers. ve Dili
Excel 2019
Altın Üyelik Bitiş Tarihi
16-07-2027
Merhaba.
Kodları çalıştırmadan önce bir tane kendiniz WhatsApp Web sayfası açın sonra kodları çalıştırın.
Cevabınız için çok teşekkür ederim bir fonksiyon yardımıyla ar kodu sormayı atladım. Fakat şimdi bir sorunum daha var. Fonksiyonları ekledikten sonra sendkeys komutları düzgün çalışmıyor. Örneğin whatsapp'a 6 satır mesaj gönderiyorum. her mesajı yazdıktan sonra alt+enter yapmasını istiyorum. aşağıdaki şekilde yaptığımda 2 mesajda alt+enter yapıyor gönderiyor 2 mesajda alt+enter yapıyor gönderiyor sonraki 2 satırı yazıyor ve göndermiyor bunun önüne nasıl geçebilirim
Kod:
Public baglan As New Selenium.WebDriver

Private Sub ListBox1_Click()


Function zaman(ByVal Acao As Double)

Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)


End Function

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
TextBox1.Enabled = True
TextBox1.BackColor = &H8000000E
Else
TextBox1.Enabled = False
TextBox1.BackColor = &HE0E0E0
End If
End Sub

Private Sub CheckBox2_Click()
Dim s As Integer
If CheckBox2.Value = True Then

For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = True
Next s
Else
For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = False
Next s
End If
End Sub



Private Sub CommandButton5_Click()

'Dim baglan As New Selenium.WebDriver
Dim ks As New keys
Dim Mesaj(20) As String
Dim KeepLoginCredentials As String


        Set baglan = InitWebDriver(KeepLoginCredentials)
        Set By = New Selenium.By
        Set ks = New Selenium.keys





baglan.Start "chrome", "https://web.whatsapp.com/"
baglan.Get "/"


UserForm2.Hide

If MsgBox("WhatsApp web Başladı MI?", vbYesNo) = vbYes Then  ' Bu soruyu ekrana soruyor önce whatsapp açıp daha sonra EVET denmelidir.

    GrupAdi = Sheets("MANEVRA KAYITLARI").Range("U2").Value   ' Whatsapp gönderilecek grup adının yazılması Denizli İşletme gibi
   'GrupAdi = "Yaşar KINAYER Adm"  ' Deneme amaçlı yazdım silinecek
   'Mesaj = Sheets(1).Range("a2").Value  ' Gönderilecek mesajın metninin yer aldığı hücre
        
        
        
    For x = 0 To ListBox1.ListCount - 1
 
         If ListBox1.Selected(x) Then
          



If CheckBox1.Value = True Then
Call SendKeys(TextBox1.Value, True)
Else
Mesaj(1) = "İstasyon Adı: " & ListBox1.List(x, 3)
Mesaj(2) = "Fider Adı: " & ListBox1.List(x, 5)

Mesaj(4) = " Açma Saati: " & Format(ListBox1.List(x, 8), "hh:mm")
Mesaj(5) = " Kapama Saati: " & Format(ListBox1.List(x, 9), "hh:mm")
Mesaj(6) = " Arıza Sinyali: " & ListBox1.List(x, 12)
Mesaj(7) = " Açıklama: " & ListBox1.List(x, 13)

     baglan.FindElementByXPath("//*[@id='side']/div[1]/div/label/div/div[2]").Click
    
    baglan.Wait (1000)
    baglan.SendKeys (GrupAdi)
    baglan.Wait (100)
    baglan.SendKeys (ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(1))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(2))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(4))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(5))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(6))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(7))
    baglan.Wait (100)
    baglan.SendKeys (ks.Enter)


    
    
    End If
        
         End If
        
         Next x

         End If

UserForm2.Hide

 

End Sub

Private Sub OptionButton2_Click()
UserForm2.Caption = "Whatsapp Mesaj Gönder"
CommandButton5.Caption = "GÖNDER"
CheckBox2.Caption = "Tümünü Seç"
CheckBox1.Caption = "Mesaji Gönder"
End Sub

Private Sub UserForm_Initialize()
  TextBox1.Enabled = False
    ListBox1.ColumnCount = 21
    ListBox1.ColumnWidths = "100;100;100"
    ListBox1.ListStyle = fmListStyleOption
   ListBox1.MultiSelect = fmMultiSelectMulti
    ListBox1.RowSource = "A1:U" & [A65532].End(3).Row
      OptionButton2 = True

End Sub

Private Function InitWebDriver(KeepLoginCredentials As String) As WebDriver
            
On Error GoTo ErrHandler
       Dim UserDataDir As String
      Set baglan = New Selenium.WebDriver
                      
                      ''' Set timeouts defined in mGlobals
baglan.Wait (500)
            
                      ''' Add additional arguments
baglan.AddArgument "--disable-popup-blocking"
baglan.AddArgument "--disable-notifications"
            
KeepLoginCredentials = "Yes"
            
                      ''' Avoid Scanning the QR Code
If KeepLoginCredentials = "Yes" Then
UserDataDir = ThisWorkbook.Path & "\" & "ChromeUserData"
Call CreateDirectory(UserDataDir)
baglan.AddArgument "--user-data-dir=" & UserDataDir
End If
                      
Set InitWebDriver = baglan
Exit Function
                      
ErrHandler:
Select Case Err.Number
                        
                          Case -2146232576
MsgBox _
                                  "Oh, it looks like that you first need to activate/install your .NET Framework." & _
                                  "But no worries! To fix this issue, follow the steps here:" & vbNewLine & _
                                  "https://pythonandvba.com/automation-error" & vbNewLine & vbNewLine & _
                                  Err.Number & ": " & Err.Description, , "WhatsApp baglan"
End
Case Else


End Select
                      
            End Function


'***********************************************************************************
Private Sub CreateDirectory(FolderPath)

          
      On Error GoTo ErrHandler
          


If Dir(FolderPath, vbDirectory) = "" Then MkDir FolderPath
          
          Exit Sub
          
ErrHandler:


MsgBox ("hata")
End Sub
 

serif_007

Altın Üye
Katılım
5 Nisan 2014
Mesajlar
155
Excel Vers. ve Dili
Excel 2019
Altın Üyelik Bitiş Tarihi
16-07-2027
Cevabınız için çok teşekkür ederim bir fonksiyon yardımıyla ar kodu sormayı atladım. Fakat şimdi bir sorunum daha var. Fonksiyonları ekledikten sonra sendkeys komutları düzgün çalışmıyor. Örneğin whatsapp'a 6 satır mesaj gönderiyorum. her mesajı yazdıktan sonra alt+enter yapmasını istiyorum. aşağıdaki şekilde yaptığımda 2 mesajda alt+enter yapıyor gönderiyor 2 mesajda alt+enter yapıyor gönderiyor sonraki 2 satırı yazıyor ve göndermiyor bunun önüne nasıl geçebilirim
Kod:
Public baglan As New Selenium.WebDriver

Private Sub ListBox1_Click()


Function zaman(ByVal Acao As Double)

Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)


End Function

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
TextBox1.Enabled = True
TextBox1.BackColor = &H8000000E
Else
TextBox1.Enabled = False
TextBox1.BackColor = &HE0E0E0
End If
End Sub

Private Sub CheckBox2_Click()
Dim s As Integer
If CheckBox2.Value = True Then

For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = True
Next s
Else
For s = 0 To ListBox1.ListCount - 1
ListBox1.Selected(s) = False
Next s
End If
End Sub



Private Sub CommandButton5_Click()

'Dim baglan As New Selenium.WebDriver
Dim ks As New keys
Dim Mesaj(20) As String
Dim KeepLoginCredentials As String


        Set baglan = InitWebDriver(KeepLoginCredentials)
        Set By = New Selenium.By
        Set ks = New Selenium.keys





baglan.Start "chrome", "https://web.whatsapp.com/"
baglan.Get "/"


UserForm2.Hide

If MsgBox("WhatsApp web Başladı MI?", vbYesNo) = vbYes Then  ' Bu soruyu ekrana soruyor önce whatsapp açıp daha sonra EVET denmelidir.

    GrupAdi = Sheets("MANEVRA KAYITLARI").Range("U2").Value   ' Whatsapp gönderilecek grup adının yazılması Denizli İşletme gibi
   'GrupAdi = "Yaşar KINAYER Adm"  ' Deneme amaçlı yazdım silinecek
   'Mesaj = Sheets(1).Range("a2").Value  ' Gönderilecek mesajın metninin yer aldığı hücre
       
       
       
    For x = 0 To ListBox1.ListCount - 1

         If ListBox1.Selected(x) Then
         



If CheckBox1.Value = True Then
Call SendKeys(TextBox1.Value, True)
Else
Mesaj(1) = "İstasyon Adı: " & ListBox1.List(x, 3)
Mesaj(2) = "Fider Adı: " & ListBox1.List(x, 5)

Mesaj(4) = " Açma Saati: " & Format(ListBox1.List(x, 8), "hh:mm")
Mesaj(5) = " Kapama Saati: " & Format(ListBox1.List(x, 9), "hh:mm")
Mesaj(6) = " Arıza Sinyali: " & ListBox1.List(x, 12)
Mesaj(7) = " Açıklama: " & ListBox1.List(x, 13)

     baglan.FindElementByXPath("//*[@id='side']/div[1]/div/label/div/div[2]").Click
   
    baglan.Wait (1000)
    baglan.SendKeys (GrupAdi)
    baglan.Wait (100)
    baglan.SendKeys (ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(1))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(2))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(4))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(5))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(6))
    baglan.Wait (100)
    baglan.SendKeys (ks.Alt & ks.Enter)
    baglan.Wait (100)
    baglan.SendKeys (Mesaj(7))
    baglan.Wait (100)
    baglan.SendKeys (ks.Enter)


   
   
    End If
       
         End If
       
         Next x

         End If

UserForm2.Hide



End Sub

Private Sub OptionButton2_Click()
UserForm2.Caption = "Whatsapp Mesaj Gönder"
CommandButton5.Caption = "GÖNDER"
CheckBox2.Caption = "Tümünü Seç"
CheckBox1.Caption = "Mesaji Gönder"
End Sub

Private Sub UserForm_Initialize()
  TextBox1.Enabled = False
    ListBox1.ColumnCount = 21
    ListBox1.ColumnWidths = "100;100;100"
    ListBox1.ListStyle = fmListStyleOption
   ListBox1.MultiSelect = fmMultiSelectMulti
    ListBox1.RowSource = "A1:U" & [A65532].End(3).Row
      OptionButton2 = True

End Sub

Private Function InitWebDriver(KeepLoginCredentials As String) As WebDriver
           
On Error GoTo ErrHandler
       Dim UserDataDir As String
      Set baglan = New Selenium.WebDriver
                     
                      ''' Set timeouts defined in mGlobals
baglan.Wait (500)
           
                      ''' Add additional arguments
baglan.AddArgument "--disable-popup-blocking"
baglan.AddArgument "--disable-notifications"
           
KeepLoginCredentials = "Yes"
           
                      ''' Avoid Scanning the QR Code
If KeepLoginCredentials = "Yes" Then
UserDataDir = ThisWorkbook.Path & "\" & "ChromeUserData"
Call CreateDirectory(UserDataDir)
baglan.AddArgument "--user-data-dir=" & UserDataDir
End If
                     
Set InitWebDriver = baglan
Exit Function
                     
ErrHandler:
Select Case Err.Number
                       
                          Case -2146232576
MsgBox _
                                  "Oh, it looks like that you first need to activate/install your .NET Framework." & _
                                  "But no worries! To fix this issue, follow the steps here:" & vbNewLine & _
                                  "https://pythonandvba.com/automation-error" & vbNewLine & vbNewLine & _
                                  Err.Number & ": " & Err.Description, , "WhatsApp baglan"
End
Case Else


End Select
                     
            End Function


'***********************************************************************************
Private Sub CreateDirectory(FolderPath)

         
      On Error GoTo ErrHandler
         


If Dir(FolderPath, vbDirectory) = "" Then MkDir FolderPath
         
          Exit Sub
         
ErrHandler:


MsgBox ("hata")
End Sub
 

Ekli dosyalar

onurbeyaz

Altın Üye
Katılım
12 Ekim 2019
Mesajlar
57
Excel Vers. ve Dili
excel2010
Altın Üyelik Bitiş Tarihi
25-06-2029
Hocam exceli varsa paylaşırmısınız teşekkürler
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Ben mesaj kutusunu set edip aşağıdaki gibi gönderdim. Sizde msgbx yerine baglan yazıp deneyin. Olmazsa mesaj kutusunu set edin.
Beklemeleri kaldırın.
Kod:
                    msgbx.SendKeys "1Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "2Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "3Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "4Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "5Your are the winner!!!" + keys.Enter
232255
 

serif_007

Altın Üye
Katılım
5 Nisan 2014
Mesajlar
155
Excel Vers. ve Dili
Excel 2019
Altın Üyelik Bitiş Tarihi
16-07-2027
Ben mesaj kutusunu set edip aşağıdaki gibi gönderdim. Sizde msgbx yerine baglan yazıp deneyin. Olmazsa mesaj kutusunu set edin.
Beklemeleri kaldırın.
Kod:
                    msgbx.SendKeys "1Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "2Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "3Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "4Your are the winner!!!", keys.Shift + keys.Enter
                    msgbx.SendKeys "5Your are the winner!!!" + keys.Enter
Ekli dosyayı görüntüle 232255
cevabınız için çok teşekkür ederim. Sorunu çözdük ve sorunun çözüldüğünü yazmak için girdiğimde cevabınızı gördüm. Nasıl çözdüğümüze gelince
baglan.Keyboard.KeyDown (ks.Shift)
baglan.SendKeys (ks.Enter)
baglan.Keyboard.KeyUp (ks.Shift)

bunu yazınca çözüldü. Çok teşekkür ederim yardımlarınız için
 
Üst