Hunkar50
Yeni Üye
- Katılım
- 30 Ocak 2022
- Mesajlar
- 303
- Çözümler
- 2
- Aldığı beğeni
- 56
- Excel V
- Office 2010 TR
- Degerli Arkadaşlar Cümleten Selamün Aleyküm . Takıldıgım bir hususta yine yardımınıza ihtiyacım var
- MJS GÖNDER butonunu tıkladıgımızda, açılan user formda yer alan listeden kişileri seçerek watsapp uygulaması üzerinden seçili kişilere msj gondermek istiyorum.
- Açılan userform dan Chekbox1 i seçtiğimizde Textbox1 de yer alan msj chekbox1 işaretlenmediği zaman H sutununda yer alan msjları göndermesi gerekmekte..
- BİLGİLENDİRME :Aşagıdaki kodlar normal şartlarda istediğim gibi çalışmakta fakat listede yer alan tüm kişilere msj göndermektedir, bana lazım olan ise seçili kişilere msj göndermesidir.
- watsap masa üstü kullanmatayım…
- İlginize teşekkürler…
Kod:
Sub borcmsj()
Dim LastRow As Long
Dim i As Integer
Dim strip As String
Dim strPhoneNumber As String
Dim strmessage As String
Dim strPostData As String
Dim IE As Object
Dim n As Long
For n = 1000 To 1 Step -1
myval = Cells(n, 2)
If myval <> "" Then
LastRow = n
Exit For
End If
Next n
For i = 3 To LastRow
If Sheets("Sayfa1").Cells(i, 5).Value >= kr Then
strPhoneNumber = Sheets("Sayfa1").Cells(i, 7).Value
strmessage = Sheets("Sayfa1").Cells(i, 8).Value
'IE.navigate "whatsapp://send?phone=phone_number&text=your_message"
strPostData = "whatsapp://send?phone=" & strPhoneNumber & "&text=" & strmessage
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate strPostData
Application.Wait (Now + TimeValue("00:00:3"))
Call SendKeys("{Enter}", True)
Application.Wait (Now + TimeValue("00:00:1"))
Application.SendKeys ("%{TAB}")
'Application.Wait (Now + TimeValue("00:00:3"))
'Call SendKeys("{Enter}", True)
'Application.Wait Now() + TimeSerial(0, 0, 5)
'SendKeys "~"
End If
Next i
End Sub
