ارسال رسائل الواتساب بالاكسيل بفكره احترافيه

ارسال رسائل الواتساب بالاكسيل

ارسال رسائل الواتساب بالاكسيل بفكره احترافيه

ارسال رسائل الواتساب بالاكسيل بفكره احترافيه يمكن من خلال الاكسيل ارسال رسائل لجهات الاتصال او للارقام غير المسجله او للمجموعات مرفق في اخر المقال الشيت المستخدم في الشرح

الواتساب

يعد الواتساب من اشهر برامج التواصل الاجتماعي فهو التطبيق الاكثر انتشارا بين مستخدمي نظام الاندرويد علي الاطلاق حيث يتجاوز عدد مستخدمي الواتساب 2.2 مليار مستخدم حول العالم و الاكثر تحميلا في برامج المراسلات

يتميز أيضا الواتساب بالخصوصيه و التشفير الكامل في المراسلات

 

شرح فكره استخدام الاكسيل في ارسال رسائل الواتساب

 

فكره عمل الشيت

تقوم فكره عمل الشيت علي استخدام الواتساب في وضع الواتساب ويب و ارسال الرسائل من خلال الاوامر المخزنه باستخدام مفاتيح الكيبورد في بتوقيت زمني محدد كان شخصا يستخدم الكيبورد في ارسال هذه الرسائل و قام بتسجيل كل زر استخدمه في عمليه الارسال و حدد فارق زمني بين كل امر و اخر

يبدا الكود بالعمل باستعداء متصفح جوجل كروم و فتح موقع واتساب ويب لاستخدامه في عمليه الارسال

ثم بعد ذلك يقوم الكود باستخدام حلقه تكراريه للدوران علي جهات الاتصال و الارقام و الاسماء المسجله في الشيت استعدادا لعمليه الارسال

 

و هذه الفكره البرمجيه هي نفس فكره عمل العديد من برامج التسويق الالكتروني من خلال الواتساب

ارسال رسائل الواتساب بالاكسيل يمكنك أيضا تطوير هذه الفكره لتناسب عملك اكثر

 

خطوات العمل

قم بتحميل الملف المرفق اخر المقال علي الكمبيوتر و تم بالتاكد من تحديث متصفح الجهاز لديك يفضل متفح جوجل كروم حتي لا تضطر الي تعديل الكود

قم باضافه الارقام و الاسماء المراد الارسال اليها في المكان المخصص و ضع نص الرساله المراد ارسالها و اضغط ارسال

 

متطلبات العمل

جهاز كمبيوتر بنظام تشغيل و يندز يحتوي علي الاوفيس و أيضا شيت العمل المرفق و متصفح يفضل ان يكون جوجل كروم باخر تحديثات له

 

الاكواد المستخدمه دخل ملف العمل

 

Sub Enviar()
Dim text As String
Dim Contato As String

text = Sheets(1).TextBox1

If text = "" Then
MsgBox "يرجى كتابة نص الرسالة!", 64, "حقل فارغ"
Exit Sub
End If

ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"
    
Fazer (15000)
 
linha = 2
Do Until Sheets(1).Cells(linha, 1) = ""

Fazer (2000)
Contato = Cells(linha, 1)


Fazer (3000)
 Call SendKeys("{TAB}", True)
 Call SendKeys(Contato, True)
Call SendKeys("~", True)

Fazer (8000)
Call SendKeys(text, True)
Call SendKeys("~", True)

linha = linha + 1

Loop


End Sub

Function Fazer(ByVal Acao As Double)

Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)

'milliSeconds
End Function


Sub teste()

Fazer (5000)
MsgBox "suel"

End Sub



 

 

تحميل ملف العمل ارسال رسائل الواتساب بالاكسيل بفكره احترافيه

تحميل مباشر

 

تحميل

يمكنك مشاهده أيضا

 

اترك تعليقاً

لن يتم نشر عنوان بريدك الإلكتروني. الحقول الإلزامية مشار إليها بـ *