اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ارسال رسائل whatsapp (وتساب) بدون حفظ الرقم


kanory

الردود الموصى بها

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

طرح في موضوع سابق موضوع رسائل الواتس

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

جربوه واعطونا انطباعكم حوله لتطويره والاستفادة منه

ملاحظة هامة يجب تنصيب رنامج الواتس في جهازك ليعمل البرنامج

هناك مدة زمنية وضعتها في الكود للتنفيذ مقدارها 40  يمكنك تغييرها ليتناسب مع سرعة جهازك ......

 

 

الطريقة سهله أوضحها باختصار مع اقتران كل شرح بالصورة ..... 

أولا : الذهاب للرابط https://www.whatsapp.com/download  وتحميل برنامج الواتس حسب نسخة الويندوز لديك ( 64 - 32 )bit

ثانيا: تشغيل برنامج الواتس والتسجيل عن طريق حسابك في الواتس وذلك بمسح البركود الظاهر في البرنامج من خلال البرنامج ( حسب الصورة )

ثالثا : عند اول تشغيل تظهر لك من خلال المتصفح رسالة بالسماح بفتح الارتباط بهذا النوع ( ضع علامة صح مثل الصورة )

رابعا : عند عمل البرنامج للمرة الثانية لا يحتاج تكرار هذه العمليات ( فقط انتظر اتمام المهمة ) هناك في الكود زمن افتراضي وضعته هو 40  ثانية أن رأيت جهازك والنت سريع حاول تقليل الزمن لكسب سرعة في الارسال أو العكس بالعكس تسجيل الارقام بالصيغة الدولية ....

 

 

 

3.png

5.png

 

منتظر انطباعاتكم حول البرنامج ؟؟؟؟

 

 

WhatsApp_kan.accdb

هنا تجدون الموضوع السابق ......

في ٢٣‏/٩‏/٢٠٢٠ at 06:27, Mohameddd200300 said:

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

كيف حالكم اخواني الكرام  اليوم حبيت اشاركم موضع الرسائل في الوتساب من خلال اكسس الطريقة ممكنه ومجربه ولاكن هناك بعض المشاكل سوفا نحلها مع بعض انشالله

طبعا الفكره تم تطبيقها في اكسل من خلال  الاستاذ ( منذر ) وهذا رابط المقطع الذي سوا فيه الشرح جزاه الله خيرا (  https://youtu.be/UX-5cFp8Yo8 )  

انا قمة مع صديقي (  ابو ياسين )  بتصميم كود ونموذج للفكرة قبل فتره ولاكن بسس انشغلينا في الحياة لم يتم اكمل الفكره   ولاكن الان الحمدلله  تم اكمال الكود ولاكن هناك بعض المشاكل كما ذكرت سابقا اتمنا ان نتعاون في حلها هي مشكلة واحده  ولاكن بي البداية  سوفا اقو بشرح الفكره وطريقة عملها بي البداية .

الشرح

اول قمة بعمل جدول ونموذج فيه  الاسم و رقم الجوال المطلوب ارسل له وايضا  نص الرساله  المطلوب     طبعا راح نحتاج في هذا الموضع  ( متصفح - وبرنامج الوتساب )    

برنامج الوتساب تقم  بتثبيته من هذا الرابط   (  https://www.whatsapp.com/download/  ) 

قم  بتسجيل الدخول من خلال الوتاسب الخص بك مثل المتصفح    والطرقة مذكورة في شرح الاستاذ منذر  في الرابط السابق (هذي الطريقة لا تسبب حضر الرقم )

طيب عمل الكود هو بي اخذ  الرقم  من النموذج   ونص الرساله وفتح المتصفح  من خلال جوجل بعد ان قمنا بتكمن الخيار بفتح التطبيق  تلقائي   سوفا يقوم بفتح الوتاسب بفتح محادثه بي الرقم الذي سجلته وكتابة الرساله وبعد 3 ثواني يقوم بغط على ارسل  .    الكود  الذي فتح المتصفح ويقوم بي اخذ الرقم وا  النص الرساله   (    Application.FollowHyperlink "https://wa.me/" & txtNumbers & "?text=" & txtMessage   )

  استخدمة دالة (  DO  )   لتكرار العميلة  حتا انها  الارقام المسجله    قمت بي ادخل  الربع ارقام كا تجربة  بعد مقمة بي عمل انتر  فتح المتصفح واخذ اللارقم مع الرسالة   وفتح الوتساب  ورسل وبعدها فتح نافذه جديده  واخذ الرقم الثاني  وفتح محادثة جديده وقام بكتابة الرسله ارسالها   ولاكن هنا المشكة بي الرقم الثالث والرابع والخ   الكود شغال  فتح اربع نوافذ ولاكن بي الرقم الثاني   المشكلة طلعة في دالة DO عند الضغط على انتر يقوم باخذ القيمة الاوله  ويرسل الكود ويرجع ياخذ السجل الثاني وياخذه  بس المشكلة بعد مايفتح المتصفح  لا ينتقل الى السجل الثالث  والكود يقوم باخذ القيمة الي وقف عليها المواشر  فهمتو  هنا المشكلة   في شي ثاني الرسالة اذا كانت عربي   مايقبلها الكود ويخليها رموز ولاكن الاخ منذر حل المشكلة من خلال الحافظ لو تابعتو الشرح بتفهمو 

  طبع الملف الي فيه الشغل  رفعته مع المقال ياليت تحملهو وتسو تجارب عليه ونتشارك الخبره مع بعض وجزاكم الله خير 

ملاحظة  (انا اول مره اكتب مقال او اشارك في موضوع بخبرتي  التي اكتسبتها بفضل الله بعدها من موقعنا هذا  (افيسنا)  ادري طولت ولاكن الموضوع يهم ناس كثير وشكرا لكم   

اخوكم (محمد احمد)

 

 

 

وتساب.zip 63 kB · 21 downloads

 

تم تعديل بواسطه jjafferr
  • Like 5
  • Thanks 4
رابط هذا التعليق
شارك

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

وفي شي ثاني ان شالله تشوفلة حل   هي  المتصفح  اذا امكن انه يلغ الصفحة التي قبله منشان ماتكثر الصفحات ويعلق فهمت علي    بشوف اذا بقدر اسويها من خلال اختاص ctrl+w من اجل اغلاق الصفحة  وشكرا لك 

رابط هذا التعليق
شارك

جزاك الله كل خير استاذ Kanory ولكن البرنامج بفتح صفحة الواتس للشخص المرسل اليه وينتظرنى ان اكتب الرسالة التى أريدها لأنه لا يقوم بإرسال الرسالة المحررة مسبقاً بالبرنامج مباشرة

 

 

 

 

 

 

  • Thanks 1
رابط هذا التعليق
شارك

اخ هاني. لا بد  من تحميل اول برنامج ابوتساب   وتفعيل بي الكود.ثاني. الدخول في كرم    وتسجيل في المتصفح ؟wa.me/966555555555?text=hi

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

وايضا. غير الكود  بدل ٤٠ خليها اقل شي ٥ 

  • Like 1
رابط هذا التعليق
شارك

2 ساعات مضت, jjafferr said:

السلام عليكم 🙂

 

اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂

يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂

 

جعفر

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

 

تم تعديل بواسطه Mohameddd200300
  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

جزاك الله خيرا اخى @kanory 💐

وما اعجبنى بدون حفظ الرقم لان فى تجربه سابقه لموضعات بالمنتدى كان لابد من حفظ الرقم وغيرت الوقت الى 50 فعمل بشكل طبيعى وكان فيه مشكله اللغه العربيه

سوف اجرب المرفق

جزاكم الله خيرا اخوانى وفقكم الله لما يحبه ويرضاه

  • Thanks 1
رابط هذا التعليق
شارك

السلام عليكم 🙂

 

اخي @kanory ، وبما اني ماعندي واتس اب ، فرجاء جرب الكود التالي ، علشان اللغة العربية :

Private Sub أمر15_Click()
On Error Resume Next
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.kan + 1
Langauge ELanguage.Ar
Dim fOK As Boolean
Dim strTemp As String
Forms!whatsapp.SetFocus
    strTemp = Me.txtMessage
    'fOK = SetClipboardData_clt(strTemp)
    
    'copy name to clipboard
    Me.txtMessage.SetFocus
    Me.txtMessage.SelStart = 0
    Me.txtMessage.SelLength = Len(Me.txtMessage)
    DoCmd.RunCommand acCmdCopy
    
'=========================================================================================================
'Langauge ELanguage.en

Application.FollowHyperlink "https://wa.me/" & txtNumbers
auseTime = 40
start = Timer
Do While Timer < start + auseTime
DoEvents
Loop
Call SendKeys("~", True)
Call SendKeys("{Enter}", True)
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
'===========================================================================================================
DoCmd.GoToRecord , , acNext
  Next
  MsgBox "انتهت الارقام"
End Sub

 

جعفر

  • Thanks 1
رابط هذا التعليق
شارك

منذ ساعه, jjafferr said:

السلام عليكم 🙂

 

اخي @kanory ، وبما اني ماعندي واتس اب ، فرجاء جرب الكود التالي ، علشان اللغة العربية :


Private Sub أمر15_Click()
On Error Resume Next
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.kan + 1
Langauge ELanguage.Ar
Dim fOK As Boolean
Dim strTemp As String
Forms!whatsapp.SetFocus
    strTemp = Me.txtMessage
    'fOK = SetClipboardData_clt(strTemp)
    
    'copy name to clipboard
    Me.txtMessage.SetFocus
    Me.txtMessage.SelStart = 0
    Me.txtMessage.SelLength = Len(Me.txtMessage)
    DoCmd.RunCommand acCmdCopy
    
'=========================================================================================================
'Langauge ELanguage.en

Application.FollowHyperlink "https://wa.me/" & txtNumbers
auseTime = 40
start = Timer
Do While Timer < start + auseTime
DoEvents
Loop
Call SendKeys("~", True)
Call SendKeys("{Enter}", True)
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
'===========================================================================================================
DoCmd.GoToRecord , , acNext
  Next
  MsgBox "انتهت الارقام"
End Sub

 

جعفر

ابشر ..... جاري التجربة 

  • Like 3
رابط هذا التعليق
شارك

الكود يقوم بفتح المتصفح ويصل حتى برنامج الواتس ولايقوم بلصق الرسالة ( جلب الرساله ) وتكون فارغة 

الكود الذي وضعته انا قبل تحويل اللغة كانت تعطي نفس نتيجة كودك انت .... وعدما حولت اللغة الى العربية قبل نسخ الرساله ثم قبل لصق الرسالة في برنامج الواتس احولها الى الانجليزية كانت تظهر الرسالة وبدون مشاكل ( بدون ظهور الرسالة بشكل فراغ أو رموز غريبة )

لكن الكود الذي قام بادراجه الاستاذ . @ابوآمنة هنا يقوم بجلب الرسالة بدون الحاجة لتغيير اللغة

في ٢٤‏/٩‏/٢٠٢٠ at 23:11, ابوآمنة said:

حياك الله أخ محمد

جرب هذا الكود بشرط أن يكون المتصفح الافتراضي Google Chrome  

هذه الطريقة تدعم العربي

لاحظ url : يبدأ api



https://api.whatsapp.com/

بينما الخاص بك لا يدعم العربي



https://wa.me/

وهذا الكود



Dim X As String
Dim rst As Variant


Set rst = CurrentDb.OpenRecordset("Select * From whatsapp")
rst.MoveFirst
Do Until rst.EOF
On Error Resume Next




Application.FollowHyperlink Address:="https://api.whatsapp.com/send?phone=" & rst!nampr & "&text=" & rst!msgboax

Pause (2)

Call SendKeys("~", True)


rst.MoveNext

Loop
Set rst = Nothing



MsgBox "تم الإرسال بنجاح"

 

 

1.png

تم تعديل بواسطه kanory
  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

42 دقائق مضت, kanory said:

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

 

طيب جربه الآن ، بعد ان اعدت لغة الكيبورد الى اللغة الانجليزية :

Private Sub أمر15_Click()
On Error Resume Next
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.kan + 1
Langauge ELanguage.Ar
Dim fOK As Boolean
Dim strTemp As String
Forms!whatsapp.SetFocus
    strTemp = Me.txtMessage
    'fOK = SetClipboardData_clt(strTemp)
    
    'copy name to clipboard
    Me.txtMessage.SetFocus
    Me.txtMessage.SelStart = 0
    Me.txtMessage.SelLength = Len(Me.txtMessage)
    DoCmd.RunCommand acCmdCopy
    
'=========================================================================================================
Langauge ELanguage.en

Application.FollowHyperlink "https://wa.me/" & txtNumbers
auseTime = 40
start = Timer
Do While Timer < start + auseTime
DoEvents
Loop
Call SendKeys("~", True)
Call SendKeys("{Enter}", True)
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
'===========================================================================================================
DoCmd.GoToRecord , , acNext
  Next
  MsgBox "انتهت الارقام"
End Sub

.

 

هي مجرد تجربة لحل مشكلة اللغة العربية ، لأنه صادفتني نفس المشكلة في احد برامجي ، واتضح ان المشكلة كانت في مكتبات الوندوز القديمة اللي ما تفهم لغات Unicode 🙂

 

جعفر

رابط هذا التعليق
شارك

في ٢٧‏/٩‏/٢٠٢٠ at 14:42, jjafferr said:

 

طيب جربه الآن ، بعد ان اعدت لغة الكيبورد الى اللغة الانجليزية :


Private Sub أمر15_Click()
On Error Resume Next
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.kan + 1
Langauge ELanguage.Ar
Dim fOK As Boolean
Dim strTemp As String
Forms!whatsapp.SetFocus
    strTemp = Me.txtMessage
    'fOK = SetClipboardData_clt(strTemp)
    
    'copy name to clipboard
    Me.txtMessage.SetFocus
    Me.txtMessage.SelStart = 0
    Me.txtMessage.SelLength = Len(Me.txtMessage)
    DoCmd.RunCommand acCmdCopy
    
'=========================================================================================================
Langauge ELanguage.en

Application.FollowHyperlink "https://wa.me/" & txtNumbers
auseTime = 40
start = Timer
Do While Timer < start + auseTime
DoEvents
Loop
Call SendKeys("~", True)
Call SendKeys("{Enter}", True)
Call SendKeys("^v", True)
Call SendKeys("{Enter}", True)
'===========================================================================================================
DoCmd.GoToRecord , , acNext
  Next
  MsgBox "انتهت الارقام"
End Sub

.

 

هي مجرد تجربة لحل مشكلة اللغة العربية ، لأنه صادفتني نفس المشكلة في احد برامجي ، واتضح ان المشكلة كانت في مكتبات الوندوز القديمة اللي ما تفهم لغات Unicode 🙂

 

جعفر

يعمل الكود بكفاءة .....

  • Like 3
رابط هذا التعليق
شارك

2 ساعات مضت, kanory said:

يعمل الكود بكفاءة

يعني برنامجك الآن يرسل باللغة العربية ، صح؟

 

هذا معناه ان مكتبات حفظ البيانات في الحافظة Clipboard التالية (قد لا يكون كلها) ، لا يعتمد اللغة العربية (او لا تعتمد Unicode ) :

Declare Function clt_OpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal hwnd As Long) As Long
Declare Function clt_GetClipboardData Lib "user32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long
Declare Function clt_GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function clt_GlobalLock Lib "kernel32" Alias "GlobalLock" (ByVal hMem As Long) As Long
Declare Function clt_lstrCpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function clt_GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (ByVal hMem As Long) As Long
Declare Function clt_CloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
Declare Function clt_SetClipboardData Lib "user32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function clt_EmptyClipBoard Lib "user32" Alias "EmptyClipboard" () As Long

 

جعفر

 

رابط هذا التعليق
شارك

في ٢٥‏/٩‏/٢٠٢٠ at 19:27, jjafferr said:

السلام عليكم 🙂

 

اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂

يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂

 

جعفر

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

كيف حالكم جميع.

اخوي @kanory  

 

عندي مشكله في الكود لما نقلته في  الوندز ٧ 

الكود حق الذهاب لسجل التالي ما يشتغل  

يتوقف  تتوقع ايش السبب 

رابط هذا التعليق
شارك

6 ساعات مضت, Mohameddd200300 said:

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

كيف حالكم جميع.

اخوي @kanory  

 

عندي مشكله في الكود لما نقلته في  الوندز ٧ 

الكود حق الذهاب لسجل التالي ما يشتغل  

يتوقف  تتوقع ايش السبب 

للاسف ليس لدي win7 للتجربة .... لكن نحتاج أحد الاخوة لدية للتجربة حتى نعرف هل هو من جهازك أو بسبب الويندوز 

ماهو اصدار الاوفيس لديك ؟؟؟

ايش اخبار ارسال الصور معك .... هل وصل لنتيجة ؟؟؟؟

  • Like 3
رابط هذا التعليق
شارك

في ٢٥‏/٩‏/٢٠٢٠ at 19:27, jjafferr said:

السلام عليكم 🙂

 

اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂

يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂

 

جعفر

 

اخوي @kanory  الحمد لله عرفت الطريق بعد بحث وتجارب. كيف اقدر ارسل صور وضبط الكود. بس الان تواجهني مشكل في وندز ٧ 

ولا بي وندز ١٠ كل شي تمام  

 

زي ماقلت بسابق لما يخلص التنفيذ اول مره. 

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

رابط هذا التعليق
شارك

18 ساعات مضت, Mohameddd200300 said:

 

اخوي @kanory  الحمد لله عرفت الطريق بعد بحث وتجارب. كيف اقدر ارسل صور وضبط الكود. بس الان تواجهني مشكل في وندز ٧ 

ولا بي وندز ١٠ كل شي تمام  

 

زي ماقلت بسابق لما يخلص التنفيذ اول مره. 

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

استعمل ....

Do Until rst.EOF

بدلا من .....

DoCmd.GoToRecord , , acFirst
For i = 1 To Me.kan + 1

جرب واعلمنا بالنتيجة

  • Like 3
رابط هذا التعليق
شارك

للاسف ماظبط يطلع اخطا في كلمة  Next   في الدالة  ياليت لو تضبط الكود عندك في الملف لي سويته اول وترفعها ونا بجرب تمام   وشكرا لك اخوي @kanory

تم تعديل بواسطه Mohameddd200300
رابط هذا التعليق
شارك

  • 3 months later...

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information