Whatsapp İle Klasördeki Resimleri Gönderme

[asi_kral]

Selamun Aleyküm Arkadaşlar
Whatsapp ile mesaj göndermeyi başardım yalnız ben bir klasör içindeki ve excel üzerinden seçili bölgeyi whatsapp ile resim ( .jpg ) göndermek istiyorum.
Yardımcı olabilir misiniz.

 

[asi_kral]

Arkadaşlar bir fikri olan var mı?
Excel üzerine getirebileğimiz bir resmi de gönderme olabilir. Klasörden excel'e resmi alabiliriz.

 

[ekmekevi]

alanı kopyalayıp Call SendKeys("^v", True) ile gönderdiğinde resim formatında gönderiyor

 

[Korhan Ayhan]

Biraz araştırınca aşağıdaki videoyu buldum.

 

[metin_0606]

Arkadaşlar bir fikri olan var mı?
Excel üzerine getirebileğimiz bir resmi de gönderme olabilir. Klasörden excel'e resmi alabiliriz.

Bir çok kişiye tek bir resim göndermek istiyorsanız yardımcı olabilirim. Göndereceğiniz kişilerin rehberinizde olmasına da gerek yok ayrıca

 

[asi_kral]

Biraz araştırınca aşağıdaki videoyu buldum.

Merhaba Korhan Bey
Bu kodu yaptım ama Sub whatsss() Dim ie As InternetExplorer Set ie = New InternetExplorer Dim MSJ As String, MyDR As String MSJ = Range("B2") Dim myobj, pictur Set myobj = ActiveSheet.DrawingObjects For Each pictur In myobj With WorksheetFunction If Mid(pictur.Name, .Search(" ", pictur.Name, 1) + 1, Len(pictur.Name)) = "Resim" Then pictur.Select pictur.Delete End If End With Next Dim emp As String, t As String MyDR = "C:\Users\Muhasebe_Orjinal\Desktop\WhatsApp\" t = ".jpg" On Error GoTo xx emp = Range("A2") ActiveSheet.Shapes.AddPicture Filename:=MyDR & emp & t xx: If Err.Number = 1004 Then MsgBox "Hatalı" End If 'ActiveSheet.Shapes(1).Copy ie.Navigate "https://web.whatsapp.com/send?phone=+900000000000&text=" & MSJ Application.Wait (Now() + TimeValue("00:00:10")) Call SendKeys("^V") SendKeys "{NUMLOCK}" Call SendKeys("{ENTER}", True) Application.Wait (Now() + TimeValue("00:00:05")) Call SendKeys("{ENTER}", True) End Sub Pasif'e aldığım kod hata veriyor.

Bir çok kişiye tek bir resim göndermek istiyorsanız yardımcı olabilirim. Göndereceğiniz kişilerin rehberinizde olmasına da gerek yok ayrıca

Bir kişiye birden fazla resim göndereceğim.

 

[Korhan Ayhan]

Tecrübe ettiğim bir konu değil. Sadece siz sorunca nette arama yaparak linkini paylaştım. Biraz uğraşırsanız çözebilirsiniz.

 

[metin_0606]

Merhaba Korhan Bey
Bu kodu yaptım ama Sub whatsss() Dim ie As InternetExplorer Set ie = New InternetExplorer Dim MSJ As String, MyDR As String MSJ = Range("B2") Dim myobj, pictur Set myobj = ActiveSheet.DrawingObjects For Each pictur In myobj With WorksheetFunction If Mid(pictur.Name, .Search(" ", pictur.Name, 1) + 1, Len(pictur.Name)) = "Resim" Then pictur.Select pictur.Delete End If End With Next Dim emp As String, t As String MyDR = "C:\Users\Muhasebe_Orjinal\Desktop\WhatsApp\" t = ".jpg" On Error GoTo xx emp = Range("A2") ActiveSheet.Shapes.AddPicture Filename:=MyDR & emp & t xx: If Err.Number = 1004 Then MsgBox "Hatalı" End If 'ActiveSheet.Shapes(1).Copy ie.Navigate "https://web.whatsapp.com/send?phone=+900000000000&text=" & MSJ Application.Wait (Now() + TimeValue("00:00:10")) Call SendKeys("^V") SendKeys "{NUMLOCK}" Call SendKeys("{ENTER}", True) Application.Wait (Now() + TimeValue("00:00:05")) Call SendKeys("{ENTER}", True) End Sub Pasif'e aldığım kod hata veriyor.

Bir kişiye birden fazla resim göndereceğim.

Bilgisayarınıza selenium yükleme şansınız varsa bende işinizi görecek bir uygulama var

 

[asi_kral]

Tecrübe ettiğim bir konu değil. Sadece siz sorunca nette arama yaparak linkini paylaştım. Biraz uğraşırsanız çözebilirsiniz.

Baya bir zamandır uğraşıyorum ama çözemedim. Çözersem paylaşırım
İlgilendiğin için Teşekkür ederim Korhan Bey ( Korhan Abi )

 

[asi_kral]

Bilgisayarınıza selenium yükleme şansınız varsa bende işinizi görecek bir uygulama var

İşyerindeyim her programı yükleme şansım yok.
Ne işe yarıyor bu program. Elinizde böyle bir dosya ver ise yükleyin ona bakayım.

 

[mamilim90]

Bende uzun zamandır bunun için uğraşıyorum ama ne yazıkkı başaramadım herşey tamam ama resim göndeirlmiyor Ctrl-C CTRL - V komutu çalışmıyor makroda kendim yapınca gönderiyor ama makroda göndermiyor bende çareyi otomatik tıklamda buldum Müşterilere resim atmam gerekiyor ürünkerin resmni bende markoyu tıklama şeklinde yaptım otomatik gönderiyor patır patır sistem güzelde çalışıyor tavsiye ederim ekran kordinatlarını bulun

Public Const MOUSEEVENTF_RIGHTDOWN = &H2
Public Const MOUSEEVENTF_RIGHTUP = &H4

Sub Düğme1_Tıklat()
SetCursorPos 445, 845 ' Burası ekranın tıklaması istediğiniz Kordinat Ben Macro Recorder Programı ile buluyorum kordinatları

mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
Application.Wait (Now + TimeValue("00:00:1"))

End Sub

Çoğaltarak istedğiniz yere tıklatırsınız her tıklamada