kanory قام بنشر سبتمبر 24, 2020 قام بنشر سبتمبر 24, 2020 (معدل) السلام عليكم ورحمة الله وبركاته طرح في موضوع سابق موضوع رسائل الواتس اضع بين يديكم برنامج يقوم بارسال رسائل الواتس بدون حفظ الرقم في جهات الاتصال ويمكن استخدامه وتطويره لارسال رسائل للعملاء مثلا جربوه واعطونا انطباعكم حوله لتطويره والاستفادة منه ملاحظة هامة يجب تنصيب رنامج الواتس في جهازك ليعمل البرنامج هناك مدة زمنية وضعتها في الكود للتنفيذ مقدارها 40 يمكنك تغييرها ليتناسب مع سرعة جهازك ...... الطريقة سهله أوضحها باختصار مع اقتران كل شرح بالصورة ..... أولا : الذهاب للرابط https://www.whatsapp.com/download وتحميل برنامج الواتس حسب نسخة الويندوز لديك ( 64 - 32 )bit ثانيا: تشغيل برنامج الواتس والتسجيل عن طريق حسابك في الواتس وذلك بمسح البركود الظاهر في البرنامج من خلال البرنامج ( حسب الصورة ) ثالثا : عند اول تشغيل تظهر لك من خلال المتصفح رسالة بالسماح بفتح الارتباط بهذا النوع ( ضع علامة صح مثل الصورة ) رابعا : عند عمل البرنامج للمرة الثانية لا يحتاج تكرار هذه العمليات ( فقط انتظر اتمام المهمة ) هناك في الكود زمن افتراضي وضعته هو 40 ثانية أن رأيت جهازك والنت سريع حاول تقليل الزمن لكسب سرعة في الارسال أو العكس بالعكس تسجيل الارقام بالصيغة الدولية .... منتظر انطباعاتكم حول البرنامج ؟؟؟؟ 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 تم تعديل سبتمبر 27, 2020 بواسطه jjafferr 5 4
Mohameddd200300 قام بنشر سبتمبر 25, 2020 قام بنشر سبتمبر 25, 2020 بصراحة مدهش جدا لبيت الطلب يعطيك العافية بس عندي استفسار لي الرقم الاول يرسلة مرتين ومنجد شكرا لك ول كل الاخوة الي شاركو في الموضوع وفي شي ثاني ان شالله تشوفلة حل هي المتصفح اذا امكن انه يلغ الصفحة التي قبله منشان ماتكثر الصفحات ويعلق فهمت علي بشوف اذا بقدر اسويها من خلال اختاص ctrl+w من اجل اغلاق الصفحة وشكرا لك
هانى محمد قام بنشر سبتمبر 25, 2020 قام بنشر سبتمبر 25, 2020 جزاك الله كل خير استاذ Kanory ولكن البرنامج بفتح صفحة الواتس للشخص المرسل اليه وينتظرنى ان اكتب الرسالة التى أريدها لأنه لا يقوم بإرسال الرسالة المحررة مسبقاً بالبرنامج مباشرة 1
Mohameddd200300 قام بنشر سبتمبر 25, 2020 قام بنشر سبتمبر 25, 2020 اخ هاني. لا بد من تحميل اول برنامج ابوتساب وتفعيل بي الكود.ثاني. الدخول في كرم وتسجيل في المتصفح ؟wa.me/966555555555?text=hi وضغط انتر بعهدا رها يضهرلك رساله هل تريد جعل المتصفح يفتح التطبيق وفي تحتا مربع صغير الي هي تاكيد مايحتاك تضهر كل مره. وخلاص وراجع الشرح الي مثبت في قسم اكسس وايضا. غير الكود بدل ٤٠ خليها اقل شي ٥ 1
Mohameddd200300 قام بنشر سبتمبر 25, 2020 قام بنشر سبتمبر 25, 2020 (معدل) 2 ساعات مضت, jjafferr said: السلام عليكم 🙂 اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂 يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂 جعفر الحمد لله قبل شوي ضبط الكود بفضل لله وجهد الاخ kanory. ان شالله اليوم بنزل مقاله كامله وفيها كل الخطوط وحل كل المشاكل الي ذكرتها اول بدون ماتحتاج تشغل الوتساب واو المتصفح ماعليك الضغط الي علي ارسال. وهو بيفتح المتصفح ويفتح وتساب تلاقي. ويرسل ويسكر الصفحه الي فتح في كروم منشان التكرار وكذا ولين يخلص. يغلق المتصفح وبرنامج وتساب ويضهر رسله. تم تعديل سبتمبر 25, 2020 بواسطه Mohameddd200300 2 1
Barna قام بنشر سبتمبر 25, 2020 قام بنشر سبتمبر 25, 2020 بارك الله فيك استاذ . @kanory برنامج جميل مشكور على البرنامج حتابع بصمت الى نهاية البرنامج منتظر البرنامج للتجربة استاذ. @Mohameddd200300 2 1
أبوبسمله قام بنشر سبتمبر 26, 2020 قام بنشر سبتمبر 26, 2020 جزاك الله خيرا اخى @kanory 💐 وما اعجبنى بدون حفظ الرقم لان فى تجربه سابقه لموضعات بالمنتدى كان لابد من حفظ الرقم وغيرت الوقت الى 50 فعمل بشكل طبيعى وكان فيه مشكله اللغه العربيه سوف اجرب المرفق جزاكم الله خيرا اخوانى وفقكم الله لما يحبه ويرضاه 1
jjafferr قام بنشر سبتمبر 27, 2020 قام بنشر سبتمبر 27, 2020 السلام عليكم 🙂 اخي @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 جعفر 1
kanory قام بنشر سبتمبر 27, 2020 الكاتب قام بنشر سبتمبر 27, 2020 منذ ساعه, 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 جعفر ابشر ..... جاري التجربة 3
kanory قام بنشر سبتمبر 27, 2020 الكاتب قام بنشر سبتمبر 27, 2020 (معدل) الكود يقوم بفتح المتصفح ويصل حتى برنامج الواتس ولايقوم بلصق الرسالة ( جلب الرساله ) وتكون فارغة الكود الذي وضعته انا قبل تحويل اللغة كانت تعطي نفس نتيجة كودك انت .... وعدما حولت اللغة الى العربية قبل نسخ الرساله ثم قبل لصق الرسالة في برنامج الواتس احولها الى الانجليزية كانت تظهر الرسالة وبدون مشاكل ( بدون ظهور الرسالة بشكل فراغ أو رموز غريبة ) لكن الكود الذي قام بادراجه الاستاذ . @ابوآمنة هنا يقوم بجلب الرسالة بدون الحاجة لتغيير اللغة في ٢٤/٩/٢٠٢٠ 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 "تم الإرسال بنجاح" تم تعديل سبتمبر 27, 2020 بواسطه kanory 2 1
kanory قام بنشر سبتمبر 27, 2020 الكاتب قام بنشر سبتمبر 27, 2020 ملاحظة ..... عند اعادة هذا السطر للعمل عمل البرنامج طبيعي .... 'Langauge ELanguage.en 3
jjafferr قام بنشر سبتمبر 27, 2020 قام بنشر سبتمبر 27, 2020 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 🙂 جعفر
kanory قام بنشر سبتمبر 30, 2020 الكاتب قام بنشر سبتمبر 30, 2020 في ٢٧/٩/٢٠٢٠ 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 🙂 جعفر يعمل الكود بكفاءة ..... 3
jjafferr قام بنشر سبتمبر 30, 2020 قام بنشر سبتمبر 30, 2020 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 جعفر
kanory قام بنشر سبتمبر 30, 2020 الكاتب قام بنشر سبتمبر 30, 2020 نعم صحيح أخي @jjafferr بارك الله في اعتمامك 4
Mohameddd200300 قام بنشر أكتوبر 1, 2020 قام بنشر أكتوبر 1, 2020 في ٢٥/٩/٢٠٢٠ at 19:27, jjafferr said: السلام عليكم 🙂 اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂 يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂 جعفر السلام عليكم ورحمة الله وبركاته كيف حالكم جميع. اخوي @kanory عندي مشكله في الكود لما نقلته في الوندز ٧ الكود حق الذهاب لسجل التالي ما يشتغل يتوقف تتوقع ايش السبب
kanory قام بنشر أكتوبر 1, 2020 الكاتب قام بنشر أكتوبر 1, 2020 6 ساعات مضت, Mohameddd200300 said: السلام عليكم ورحمة الله وبركاته كيف حالكم جميع. اخوي @kanory عندي مشكله في الكود لما نقلته في الوندز ٧ الكود حق الذهاب لسجل التالي ما يشتغل يتوقف تتوقع ايش السبب للاسف ليس لدي win7 للتجربة .... لكن نحتاج أحد الاخوة لدية للتجربة حتى نعرف هل هو من جهازك أو بسبب الويندوز ماهو اصدار الاوفيس لديك ؟؟؟ ايش اخبار ارسال الصور معك .... هل وصل لنتيجة ؟؟؟؟ 3
Mohameddd200300 قام بنشر أكتوبر 1, 2020 قام بنشر أكتوبر 1, 2020 في ٢٥/٩/٢٠٢٠ at 19:27, jjafferr said: السلام عليكم 🙂 اخوي kanory الأحظ انه هناك خطوات لجعل البرنامج يعمل ، مثل ما قال اخونا محمد 🙂 يا ريت تعطي هذه الخطوات ، وبالتفصيل ، حتى اضيفها الى مشاركتك الأولى ، وبها يكتمل الموضوع 🙂 جعفر اخوي @kanory الحمد لله عرفت الطريق بعد بحث وتجارب. كيف اقدر ارسل صور وضبط الكود. بس الان تواجهني مشكل في وندز ٧ ولا بي وندز ١٠ كل شي تمام زي ماقلت بسابق لما يخلص التنفيذ اول مره. عند امر انتقل لسجل التالي يقول خطاء. بسبب ان الملف اكسس مش فاتح اقصد في بارمج زي الوتساب والمتصفحه فاتحين وكذا هذا سبب المشكله
kanory قام بنشر أكتوبر 2, 2020 الكاتب قام بنشر أكتوبر 2, 2020 18 ساعات مضت, Mohameddd200300 said: اخوي @kanory الحمد لله عرفت الطريق بعد بحث وتجارب. كيف اقدر ارسل صور وضبط الكود. بس الان تواجهني مشكل في وندز ٧ ولا بي وندز ١٠ كل شي تمام زي ماقلت بسابق لما يخلص التنفيذ اول مره. عند امر انتقل لسجل التالي يقول خطاء. بسبب ان الملف اكسس مش فاتح اقصد في بارمج زي الوتساب والمتصفحه فاتحين وكذا هذا سبب المشكله استعمل .... Do Until rst.EOF بدلا من ..... DoCmd.GoToRecord , , acFirst For i = 1 To Me.kan + 1 جرب واعلمنا بالنتيجة 3
Mohameddd200300 قام بنشر أكتوبر 2, 2020 قام بنشر أكتوبر 2, 2020 (معدل) للاسف ماظبط يطلع اخطا في كلمة Next في الدالة ياليت لو تضبط الكود عندك في الملف لي سويته اول وترفعها ونا بجرب تمام وشكرا لك اخوي @kanory تم تعديل أكتوبر 2, 2020 بواسطه Mohameddd200300
shareefalajouz قام بنشر يناير 15, 2021 قام بنشر يناير 15, 2021 جزاكم الله كل خير ..على هذا العمل الجميل .. ولكن ممكن لوكان زر الامر ارسال الرسالة امام كل سجل بحيث ان اقوم بارسال الرسالة لكل شخص على حدة المختار فقط دون الحاجة لارسال رسالة الى الكل حتى وان كانت مختلفة .. مع امكانية ابقاء امر ارسال للكل قائم .. ولكم جزيل الشكر ..
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.