• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

WhatsApp ile otomatik olarak dinamik mesaj gönderme

T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,903
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Merhaba Arkadaşlar,
Sitede yaptığım aramalarda ;
https://www.excel.web.tr/threads/excel-ile-web-whatsappa-mesaj-goenderme.176607/#post-974774
Bu adresteki dosya ile tek kişiye, kişiyi oluşturup manuel olarak yazıp gönderebiliyorsunuz

https://excel.web.tr/threads/whatsapp-da-otomatik-veri-goenderimi.166843/
Bu adresteki dosya telefonu listede olan herkese aynı mesajı otomatik olarak gönderiyor.

Acaba gönderilecek her kişide bilgi değişikliği varsa WhatsApp'ta bu nasıl gönderilir? Daha da doğrusu, örnekteki ilk sayfada C3:H12 arasını birleştirmişler. Ama nasıl yapılmış anlamadım. O bölüm değişken kabul etmiyor. Bunu anlayabilirsen sorunu çözerim. (Bu çalışma Mozilla'da güzel çalışıyor)
Saygılarımla
 

Ekli dosyalar

Son düzenleme:
Hocam, bu şekilde deneyiniz.
Mesaj sayfasında gönderilecek mesajı istediğiniz şekilde değiştirebilirsiniz.

Kod: 
Sub Gonder()
' işlem sırasında mouse'un odağını tıklatamaz veya değiştiremez veya tuşlara basamazsın
Dim text As String
Dim Contato As String

mesajorg = Sheets("Mesaj").Range("A1").Value

If mesajorg = "" Then
   MsgBox "Gönderilecek mesajı gir!", 64, "Prosedür Hatası"
   Exit Sub
End If

Shell "C:\Program Files (x86)\Mozilla Firefox\firefox.exe" & " https://web.whatsapp.com/"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"

Fazer (15000)
linha = 2

Do Until Sheets(1).Cells(linha, 1) = ""
    Fazer (2000)
    Contato = Cells(linha, 1)
    adi = Cells(linha, "B").Value
    link = Cells(linha, "C").Value
    mesaj = Replace(mesajorg, "{ADI}", adi)
    mesaj = Replace(mesaj, "{LINK}", link)
   
    If Contato = "" Then
        MsgBox "İrtibat adresini doldurun!", 64, "Lütfen en az birkişi girin"
        Exit Sub
    End If

    Fazer (3000)
    Call SendKeys("{TAB}", True)
    Call SendKeys(Contato, True)
    Call SendKeys("~", True)

    Fazer (8000)
    Call SendKeys(mesaj, True)
    Call SendKeys("~", True)
    Cells(linha, "D").Value = "Gönderildi"
    linha = linha + 1
Loop
End Sub

Function Fazer(ByVal Acao As Double)
    Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)
End Function

Sub teste()
    Fazer (5000)
    MsgBox "suel"
End Sub
 

Ekli dosyalar

merhaba b
asri' Alıntı:
Hocam, bu şekilde deneyiniz.
Mesaj sayfasında gönderilecek mesajı istediğiniz şekilde değiştirebilirsiniz.

Kod: 
Sub Gonder()
' işlem sırasında mouse'un odağını tıklatamaz veya değiştiremez veya tuşlara basamazsın
Dim text As String
Dim Contato As String

mesajorg = Sheets("Mesaj").Range("A1").Value

If mesajorg = "" Then
   MsgBox "Gönderilecek mesajı gir!", 64, "Prosedür Hatası"
   Exit Sub
End If

Shell "C:\Program Files (x86)\Mozilla Firefox\firefox.exe" & " https://web.whatsapp.com/"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"

Fazer (15000)
linha = 2

Do Until Sheets(1).Cells(linha, 1) = ""
    Fazer (2000)
    Contato = Cells(linha, 1)
    adi = Cells(linha, "B").Value
    link = Cells(linha, "C").Value
    mesaj = Replace(mesajorg, "{ADI}", adi)
    mesaj = Replace(mesaj, "{LINK}", link)
  
    If Contato = "" Then
        MsgBox "İrtibat adresini doldurun!", 64, "Lütfen en az birkişi girin"
        Exit Sub
    End If

    Fazer (3000)
    Call SendKeys("{TAB}", True)
    Call SendKeys(Contato, True)
    Call SendKeys("~", True)

    Fazer (8000)
    Call SendKeys(mesaj, True)
    Call SendKeys("~", True)
    Cells(linha, "D").Value = "Gönderildi"
    linha = linha + 1
Loop
End Sub

Function Fazer(ByVal Acao As Double)
    Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)
End Function

Sub teste()
    Fazer (5000)
    MsgBox "suel"
End Sub
Genişletmek için tıkla ...


Merhaba sayın @asri

Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/

bende macro burada takılıyor, syntax error veriyor. sorun ne olabilir..
 
Sayın Asri Hocam,
Her zamanki gibi süpersiniz. Çok teşekkür ederim.
Saygılarımla
 
asri' Alıntı:
Hocam, bu şekilde deneyiniz.
Mesaj sayfasında gönderilecek mesajı istediğiniz şekilde değiştirebilirsiniz.

Kod: 
Sub Gonder()
' işlem sırasında mouse'un odağını tıklatamaz veya değiştiremez veya tuşlara basamazsın
Dim text As String
Dim Contato As String

mesajorg = Sheets("Mesaj").Range("A1").Value

If mesajorg = "" Then
   MsgBox "Gönderilecek mesajı gir!", 64, "Prosedür Hatası"
   Exit Sub
End If

Shell "C:\Program Files (x86)\Mozilla Firefox\firefox.exe" & " https://web.whatsapp.com/"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"

Fazer (15000)
linha = 2

Do Until Sheets(1).Cells(linha, 1) = ""
    Fazer (2000)
    Contato = Cells(linha, 1)
    adi = Cells(linha, "B").Value
    link = Cells(linha, "C").Value
    mesaj = Replace(mesajorg, "{ADI}", adi)
    mesaj = Replace(mesaj, "{LINK}", link)
  
    If Contato = "" Then
        MsgBox "İrtibat adresini doldurun!", 64, "Lütfen en az birkişi girin"
        Exit Sub
    End If

    Fazer (3000)
    Call SendKeys("{TAB}", True)
    Call SendKeys(Contato, True)
    Call SendKeys("~", True)

    Fazer (8000)
    Call SendKeys(mesaj, True)
    Call SendKeys("~", True)
    Cells(linha, "D").Value = "Gönderildi"
    linha = linha + 1
Loop
End Sub

Function Fazer(ByVal Acao As Double)
    Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)
End Function

Sub teste()
    Fazer (5000)
    MsgBox "suel"
End Sub
Genişletmek için tıkla ...
Eklenen dosyayı indiremiyoruz "dosyayukle" sitesinden ekleyebilirsiniz mümkün ise
 
Merhaba Arkadaşlar,
Bu konudaki whatsapp.xlsm dosyasını kendime göre düzenlemeye çalıştım fakat sanırım bir yerlerde hata yaptım.
Dosyanın orjinalinde mesaj göndermek için B ve C sütunlarından veri çekiyordu. Benim daha fazla sütunda veriye çekmeye ihtiyacım var.
Yardımcı olursanız çok memnun olurum.

Not: Sanırım daha önce @asri Bey dosyayı çalışır hale getirmiş. Tekrar yardımcı olabilirseniz çok memnun olurum.
 

Ekli dosyalar

Dosyayı istediğim gibi düzenledim, test ettim, çalıştı. Kaydedip kapattım.
Şimdi kullanmak için açtığımda
"Run-time error '5': Invaild procedure call or argument hatası alıyorum.
Debug ile hatayı görmek istediğimde aşağıdaki kodda hata veriyor.
Call SendKeys (mesaj, True)

Sebebini anlayamıyorum, lütfen yardımcı olur musunuz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst