Soru VBA ile otomatik mesaj gönderme

[sharifoghlu]

Azerbaycandan merhabalar! Nasılsınız? Şu şekilde bir VBA yazılımı hazırladık.
Sadece bazı eksikler mevcut. Mesela istiyoruz ki eğer ki numara yerlerinde numara yazılı değilse linkler hazırlanmasın. Boş kalsın...



Sub linkleri_hazirla3()
Dim sayfa As Worksheet
Set sayfa = Sheets("Sheet1")
son = sayfa.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To son
numara = Sheets("Sheet1").Range("B" & i)
mesaj = Sheets("Sheet1").Range("E" & i)
Sheets("Sheet1").Range("F" & i) = "https://api.whatsapp.com/send?phone=+994" & numara & "&text=" & mesaj
Range("F" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Range("F" & i)

Next
For i = 2 To son
numara = Sheets("Sheet1").Range("C" & i)
mesaj = Sheets("Sheet1").Range("E" & i)
Sheets("Sheet1").Range("G" & i) = "https://api.whatsapp.com/send?phone=+994" & numara & "&text=" & mesaj
Range("G" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Range("G" & i)

Next
For i = 2 To son
numara = Sheets("Sheet1").Range("D" & i)
mesaj = Sheets("Sheet1").Range("E" & i)
Sheets("Sheet1").Range("H" & i) = "https://api.whatsapp.com/send?phone=+994" & numara & "&text=" & mesaj
Range("H" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Range("H" & i)
Next

End Sub



İlaveten de otomatik olarak yalnızca mevcut olan linklere tıklamakla, vatsapta da enter uygulayarak mesajı göndersin...
Sub gonderime_basla()

For i = 2 To 5
Range("B" & i).Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Application.Wait (Now + TimeValue("00:00:10"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:10"))
Next
End Sub



Bununla ilişkin yardım ede bilirseniz çok-çok sevinirim. Benimle mail yoluyla da iletişime geçebilirsiniz... Çok teşekkür ederim.
sharifoghlu@gmail.com

 

[Asri]

1. soru için kullanabilirsiniz.

Dim sayfa As Worksheet
Set sayfa = Sheets("Sheet1")

son = sayfa.Cells(sayfa.Rows.Count, "A").End(xlUp).Row

For i = 2 To son
    numarab = sayfa.Range("B" & i)
    numarac = sayfa.Range("C" & i)
    numarad = sayfa.Range("D" & i)
    mesaj = sayfa.Range("E" & i)
  
    If numarab <> "" And sayimi(numarab) Then
        sayfa.Range("F" & i) = "https://api.whatsapp.com/send?phone=+994 " & numarab & "&text=" & mesaj
        sayfa.Range("F" & i).Hyperlinks.Add Anchor:=sayfa.Range("F" & i), Address:=sayfa.Range("F" & i)
    End If
    If numarac <> "" And sayimi(numarac) Then
        sayfa.Range("G" & i) = "https://api.whatsapp.com/send?phone=+994 " & numarac & "&text=" & mesaj
        sayfa.Range("G" & i).Hyperlinks.Add Anchor:=sayfa.Range("G" & i), Address:=sayfa.Range("G" & i)
    End If
    If numarad <> "" And sayimi(numarad) Then
        sayfa.Range("H" & i) = "https://api.whatsapp.com/send?phone=+994 " & numarad & "&text=" & mesaj
        sayfa.Range("H" & i).Hyperlinks.Add Anchor:=sayfa.Range("H" & i), Address:=sayfa.Range("H" & i)
    End If
Next
End Sub

Function sayimi(sadecesayistr)
  liste = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) = 0 Then
       sayimi = False
       Exit Function
    End If
  Next k
  sayimi = True
End Function

 

[sharifoghlu]

Teşekkür ederim. İşe yaradı efendim. İlaveten başka yardımcı ola bilecek biri varmıdır?