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