Excel Den Whats Up A Toplu Mesaj Gönderme Hakkında

Ülkemizde uygulanan 6698 sayılı KVKK, 6563 Elektronik Ticaretin Düzenlenmesi Hakkında Kanun,5809 sayılı Elektronik Haberleşme Kanunu ve Ticari İletişim ve Ticari Elektronik İletiler Hakkında Yönetmelik, Avrupa ve ABD gibi ülkelerdeki adı ile GDPR, CCMS ve benzeri uygulamalar nedeni ile alıcının açık rızası olmaksızın bu tip iletileri gönderemeniz yasal olarak engellenmiş durumdadır. Whatsapp bunun ile ilgili olarak sunduğu çözüm White List olarak adlandırılan bir listeye kullanıcıların eklenmesini sağlayarak iletişime izin vermektir. Peki bu white list nasıl oluşturuluyor kullanıcının öncelikle sizin numaranıza mesaj göndermesi gerekiyor aksi halde siz bu numaralara mesaj gönderemiyorsunuz. Business arayüzünü kullanmamanız değişiklik yapmaz numaranız business kayıtlı olduğu için aynı regülasyona tabi olursunuz.

O zaman Whatsapp Business ile mevcut kayıtlar üzerinden devam edeceğiz. Yeni kayıtlarda da mutlaka kendi numaramıza bir mesaj attıracağız. Kötü oldu bu ama yapacak bir şey yok. Ben kaldığım yerden devam edeyim programın son halini atayım o zaman yardımcı olabilirseniz sevinirim. Teşekkürler.

Merhaba.Arşivimdeki kodu sizin dosyaya uyarladım.

#If VBA7 Then 'Numlock icin

    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

#Else

    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

#End If



Sub DikdörtgenKöþeleriYuvarlatýlmýþ1_Týkla()

    Dim i As Long

    With ThisWorkbook.Sheets("MESAJ")

        .Shapes("Ýmza").Copy

      For i = 3 To 5

            DoEvents

              Set ie = CreateObject("InternetExplorer.Application")

              ie.Navigate "https://web.whatsapp.com/send?phone=" & .Cells(i, 1).Value & "&text=" & .Cells(i, 2).Value

              Application.Wait Now + TimeValue("00:00:05")

              SendKeys "^v" 'v normal v

              Application.Wait Now + TimeValue("00:00:05")

              Call SendKeys("{Enter}", True)

              Application.Wait Now + TimeValue("00:00:05")

              SendKeys "^{F4}"

              Application.Wait Now + TimeValue("00:00:05")

              Call SendKeys("{Enter}", True)

              Set ie = Nothing

      Next

    End With

    Application.CutCopyMode = False

    If GetKeyState(vbKeyNumlock) = 0 Then SendKeys "{NUMLOCK}", True 'Numlock icin

    MsgBox "Bitti"

End Sub

Feraz Hocam Kırmızı Functıon satırını sildiğimde ilk çalıştı gönderimleri yaptı. Fakat kapatıp açtığımda hata vermeye başladı. Gönderimde de istediğim gibi sekmeleri kapattı ama ekte göndermesi gereken imza isimli resmi yine göndermedi. For döngüsünde de dosyada kaç satır varsa o kadar işlem yapmasını satırda değer yoksa işlemin sonlanmasını for each döngüsü ilemi sağlayabiliriz. Dosyada ki kodda sabit değer veriyorum 10 kez işlemi tekrar et diye..Bu işlemi nasıl dinamik yapabilirim.

Resimi göremiyorum ve hatayı tabii.Yanlış anlamadıysam doevens in altına alttaki kodu kesip ekleyin.

@feraz Hocam Resmin eklenmemesinin sebebi Resmin Adını İmza Şeklinde yazmış olmam sanırım Imza Olarak ismi değiştirdim şu an resimde ekleniyor. For döngüsü için ne yapabilirim dinamik olarak kaç satır varsa o kadar çalışması için.