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

[meslek5]

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.

 

[kemal turan]

Bende takipteyim

 

[miralemdoganaktas]

rez alalım benim de baya işime yarayacak bir proje

 

[Korhan Ayhan]

Belki faydası olabilir..

https://www.youtube.com/results?search_query=excel+whatsapp+mesaj+g%C3%B6nderme

 

[Biolightant]

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

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.

 

[meslek5]

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

İlginiz ve emeğiniz için teşekkür ederim hocam. Userform çalışmanızı sabırsızlıkla bekliyoruz. Userform üzerine 1 adette gönderim süresini belirlemek için combobox eklenirse harika olur