VBA Kodu İle Whatsapp'a Mesaj, Pdf ve Jpg gönderimi

M

meslek5

Katılım
19 Eylül 2012
Mesajlar
291
Excel Vers. ve Dili
2010 türkçe
Değerli Excel üstatları şimdiye kadar gerek forum üzerinden gerekse şahsi mesaj yoluyla bir çok defa kod yardımı aldım. Yardımcı olan herkese çok teşekkür ederim.
Bu ve buna benzer açılan konuları araştırdım ama tam sonuçlanmadan konu kapatılmış olduğu için aradığım yanıtı bulamadım. Bu yüzden tekrar aynı konuyu açmış oldum kusura bakmayın.

Userform üzerinde yapmak istediğim;
- Textbox1=Telefon Numarası
- Textbox2=Metin Mesajı
- Commandbutton1=Dosya Ekle
- Textbox3=Dosya Yolu
- Commandbutton2=Whatsapp'a Gönder

Bunun VBA kodları ile olabilirliği mümkün ise yardımlarınızı bekliyorum. Teşekkür ederim.
 
Biolightant

Biolightant

Katılım
6 Mart 2024
Mesajlar
70
Excel Vers. ve Dili
Excel 2013 TR & Excel 2016 TR
Merhaba

Kodlar pamuk ipliğine bağlı olarak çalışıyor

Crome veya Edge kullanılabilir

Web WhatsApp ın arayüzü değiştiğinde,
internetiniz yavaşladığında,
bilgisayar yavaşladığında,
ek dosya çok büyükse vs...
Kodlar çökecektir.

ilk Web WhatsApp da oturumunuzu açınız

C++: 
Sub WhatsAppWebAttachmentFile()
    Dim PhoneNumber As String
    Dim Message As String
    Dim DosyaYol As Variant
    Dim WhatsAppUrl As String
   
   
    PhoneNumber = "+905123456789" ' WhatsApp desteklenen telefon numarası
   
    Message = "Merhaba Dünya" ' WhatsApp Mesaj metni
    Message = Application.WorksheetFunction.EncodeURL(Message) ' mesajı URL formatına çevir
   
    DosyaYol = "C:\....\...\DENEME.pdf"

    WhatsAppUrl = "https://web.whatsapp.com/send?phone=" & PhoneNumber & "&text=" & Message
   
    ' Shell nesnesini oluştur
    Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
   
    ' Crome veya Edge kullnarak adresi aç
    shell.Run "chrome.exe " & WhatsAppUrl ' "chrome.exe " veya "msedge.exe " Sonda bir boşluk olacak
    Application.Wait (Now + TimeValue("0:00:10")) ' bilgisayar ve(veya) internetiniz yavaş sa süreyi uzatınız
   
    Call SendKeys("{ENTER}", True) ' yazı mesajını gönder
    Application.Wait (Now + TimeValue("00:00:03"))
   
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Dosya yükleme komutları
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.SendKeys ("+{TAB}")
    Application.Wait (Now + TimeValue("00:00:01"))
    Call SendKeys("{ENTER}", True)
    Application.Wait (Now + TimeValue("00:00:01"))

    Call SendKeys("{DOWN 1}", True) ' 1 Belge , 2 Fotograflar ve videolar
    Application.Wait (Now + TimeValue("00:00:01"))
    Call SendKeys("{ENTER}", True)
    Application.Wait (Now + TimeValue("00:00:01"))

    shell.SendKeys DosyaYol ' Yüklenmesi gereken dosya tam yolu
    Application.Wait (Now + TimeValue("0:00:01"))
    Call SendKeys("{ENTER}", True)
    Application.Wait (Now + TimeValue("0:00:05")) ' göndereceginiz dosyalar büyükse süreyi uzatınız
   
    ' Dosya gönder
    Call SendKeys("{ENTER}", True)
    Application.Wait (Now + TimeValue("0:00:01"))
    Call SendKeys("{ENTER}", True)
    Application.Wait (Now + TimeValue("0:00:01"))
   
    SendKeys "{NUMLOCK}"
   
    ' Shell nesnesini serbest bırak
    Set shell = Nothing

End Sub

UserForm Şeklinde ki Excel Eklenti si olarak zaman buldukca yapıyorum bitince yeni mesajı iletirim.
 
M

meslek5

Katılım
19 Eylül 2012
Mesajlar
291
Excel Vers. ve Dili
2010 türkçe
Biolightant' Alıntı:
Merhaba

UserForm şeklinde Excel EKLENTİ olarak WebWhatsApp.xlam dosyası.

Yine Kodlar pamuk ipliğine bağlı olarak çalışıyor.
ilk olarak Web WhatsApp da oturumunuzu açınız
@meslek5 arkadaşın istediği ComboBox eklendi.
Mesaj olarak Sadece Metin veya (Metin + Dosya) gönderebilirsiniz.

WebWhatsApp.xlam


Genişletmek için tıkla ...
Hocam dosyayı açtığımda karşıma gri bir ekrandan başka bir şey çıkmıyor. neyi etkinleştirmem gerekiyor.
Tamam bir şekilde açmayı başardım. bu defa da aşağıdaki, satırda hata veriyor. Acaba bahsettiğiniz eklentiyi mi yüklemem gerekiyor.?

Message = Application.WorksheetFunction.EncodeURL(MesajBox.Value) ' mesajı URL formatına çevir
 
Son düzenleme:
Biolightant

Biolightant

Katılım
6 Mart 2024
Mesajlar
70
Excel Vers. ve Dili
Excel 2013 TR & Excel 2016 TR
Merhaba,
Bu bir Excel EKLENTİ *.xlam dosyası
Bu yaptığım Eklenti dosyası
En tepede ki Excel menüsüne(Eklentiler menüsüne)
bir tuş ekliyor bunu tıkladığınızda UserForm açılıyor.
Artık Tüm Excel Kitaplarında eklenti kullanılır oluyor

ilk Boş bir Excel Dosyası açtıktan sonra
Excel eklentisini yüklemek için sıra ile takip ediniz






Excel in En yukarısında ki Menülerde en sonda Eklentiler diye bir sekme gözükmek si gerekmekte
Bu Eklentiler sekmesini Tıklayınca da Araçlar Butonunu görmelisiniz.
 
Son düzenleme:
Biolightant

Biolightant

Katılım
6 Mart 2024
Mesajlar
70
Excel Vers. ve Dili
Excel 2013 TR & Excel 2016 TR
meslek5' Alıntı:
Message = Application.WorksheetFunction.EncodeURL(MesajBox.Value) ' mesajı URL formatına çevir
Genişletmek için tıkla ...
Aynı problemi yaşayanlar için Excel Dosyası

Problemin sebebi

Kod: 
=URLKODLA("1. satır
ığüşiöç
ĞÜŞİÖÇ")

=ENCODEURL("1. satır
ığüşiöç
ĞÜŞİÖÇ")
Bazı excel versiyonların da bu Fonksiyon yokmuş :(

Çözüm olarak zorunlu Function yapıldı
C++: 
Function EncodeTurkishChars(str As String) As String
    str = Replace(str, "ğ", "%C4%9F")
    str = Replace(str, "Ğ", "%C4%9E")
    str = Replace(str, "ü", "%C3%BC")
    str = Replace(str, "Ü", "%C3%9C")
    str = Replace(str, "ş", "%C5%9F")
    str = Replace(str, "Ş", "%C5%9E")
    str = Replace(str, "ı", "%C4%B1") ' veya %C4%B0 (büyük I için)
    str = Replace(str, "İ", "%C4%B0")
    str = Replace(str, "ö", "%C3%B6")
    str = Replace(str, "Ö", "%C3%96")
    str = Replace(str, "ç", "%C3%A7")
    str = Replace(str, "Ç", "%C3%87")
    str = Replace(str, " ", "%20") ' Boşluk karakterini kodla
    str = Replace(str, vbCrLf, "%0A") ' Satır sonlarını kodla

    EncodeTurkishChars = str
End Function
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst