[ سلسلة هدايا الأكسس | 03 ] مكتبة الموقع - 🎁 :: مرسال الواتسأب :: 📨 :: الإصدار الثاني 2.0 :: مطور :: 🧬🏹

[Moosak]

اعرض الملف

🎁 :: مرسال الواتسأب :: 📨 :: الإصدار الثاني 2.0 :: مطور :: 🧬🏹

---

السلام عليكم ورحمة الله وبركاته
يسرني اليوم أن أقدم لكم هذه الهدية المتميزة والرائعة

 (مرسال الواتسأب) مع المرفقات

مرسال الواتسأب مع المرفقات | سلسلة هدايا الأكسس | 03| 🎁
 

وهو عبارة عن برنامج صغير لإرسال الرسائل للواتسأب مع المرفقات ..

:: من مميزات هذا الإصدار ::

- إرسال رسائل فردية أو جماعية عن طريق برنامج الواتسأب .
- لا يحتاج لبرنامج الإنترنت إكسبلورر لفتح الواتسأب.
- لا يغلق مفتاح الـ NumLock بعد الإرسال.
-تم اختصار الكود في موديول واحد ودالة واحدة تقوم بعملية الإرسال بعدة خيارات .
- لو أردت تطبيق الكود في برنامجك الخاص ستحتاج لنقل الموديول إلى برنامجك + سطر برمجي واحد فقط لعملية الإرسال.

:: شرح البرنامج ::

 

 

:: لتحميل البرنامج ::

 

---

• صاحب الملف
  Moosak
• تمت الاضافه
  30 مار, 2023
• الاقسام
  قسم الأكسيس

 

[Moosak]

:: إضـــــافـــة ::

هذا هو الموديول الذي يمكنك نقله إلى برنامجك الخاص ومناداته باسم الدالة ..

Option Compare Database
Option Explicit

Enum AttacmentsType
Image = 1
Sticker = 2
Document = 3
End Enum

#If VBA7 Or Win64 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
    Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
    Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

#End If
Private Const VK_NUMLOCK = &H90


Public Sub SendToWhatsApp(txtPhone As String, txtMSG As String, Optional txtAttchmentPath As String = "", Optional AttachmentType As AttacmentsType = Image)

'---------------------------------------(التحقق من اكتمال البيانات)

If Len(txtMSG & "") = 0 Then MsgBox "يرجى كتابة الرسالة": Exit Sub

If txtAttchmentPath <> "" Then
If Len(Dir(txtAttchmentPath, vbDirectory)) = 0 Then MsgBox "المرفق غير موجود .. تأكد من الرابط": Exit Sub
End If

    txtMSG = Replace(txtMSG, vbCrLf, " %0a ")
    txtMSG = Replace(txtMSG, Chr(10), " %0a ")
    txtMSG = Replace(txtMSG, Chr(13), " %0a ")

'---------------------------------------(بداية الإرسال)
Dim Path As String
Path = "whatsapp://send?phone=" & txtPhone & "&text=" & txtMSG

CreateObject("Shell.Application").Namespace(0).ParseName(Path).InvokeVerb "Open"

    ' إرسال الرسالة
Sleep 2000
SendKeys "~"
Sleep 500
SendKeys "~"

    ' إرسال المرفق إن وجد
    If txtAttchmentPath <> "" Then
        SendKeys "+{TAB}"
        SendKeys "~"
        Sleep 1000
        
            Select Case AttachmentType
            Case Is = 1   ' صورة
                    SendKeys "{UP}"   ' لإرسال الصور
            '        SendKeys "{UP}"  ' لإرسال الملصقات
            '        SendKeys "{UP}"  ' لفتح الكاميرة
            '        SendKeys "{UP}"  ' لإرسال مستند
            '        SendKeys "{UP}"  ' لإرسال جهة إتصال
          
            Case Is = 2   ' ملصق
                    SendKeys "{UP}"   ' لإرسال الصور
                    SendKeys "{UP}"   ' لإرسال الملصقات
            '        SendKeys "{UP}"   ' لفتح الكاميرة
            '        SendKeys "{UP}"   ' لإرسال مستند
            '        SendKeys "{UP}"  ' لإرسال جهة إتصال
            
            
            Case Is = 3   ' مستند
                    SendKeys "{UP}"   ' لإرسال الصور
                    SendKeys "{UP}"   ' لإرسال الملصقات
                    SendKeys "{UP}"   ' لفتح الكاميرة
                    SendKeys "{UP}"   ' لإرسال مستند
            '        SendKeys "{UP}"  ' لإرسال جهة إتصال
            
            End Select
        SendKeys "~"
        Sleep 1000
        SendKeys txtAttchmentPath, True
        SendKeys "~"
        Sleep 2000
        SendKeys "~"
        Sleep 1000
        SendKeys "~"
    End If
        
  
    'If NumLock is off, turn it on
    If GetKeyState(VK_NUMLOCK) = 0 Then
        'Send NumLock key press to turn it on
        SendKeys "{NUMLOCK}"
    End If
        
'---------------------------------------( إعادة التركيز لبرنامج الأكسس)
    SetForegroundWindow Application.hWndAccessApp
'    MsgBox "      تم الإرســــــال           ", vbMsgBoxRight, ""

End Sub

وهكذا تنادي الدالة :

SendToWhatsApp "96899445566", "السلام عليكم", "C:\Users\User\Desktop\123.jpg", Image

 

[النجاشي]

بارك الله فيك استاذنا موسي روووعه 

زادك الله علما ما شاء الله عليك هل من الممكن استاذي تطويره بحيث أن يكون يشتغل بدون تنصيب تطبيق الواتساب تحياتي يالغالي

 

 

 

[محمد احمد لطفى]

جزاك الله خيراً أستاذى @Moosak

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

ربنا يبارك فيك و يحفظك 

[Moosak]

17 دقائق مضت, النجاشي said:

هل من الممكن استاذي تطويره بحيث أن يكون يشتغل بدون تنصيب تطبيق الواتساب تحياتي يالغالي

للنسخة العادية من الواتسأب غير متاح .. ولكن للنسخة التجارية المدفوعة يمكن عن طريق دوال ال Api الخاصة بشركة الواتسأب ..

 

15 دقائق مضت, محمد احمد لطفى said:

برجاء التطوير بحيث يمكن ارسال رسالة مختلف لكل شخص باسمه مثلا او اضافة بيانات اخرى مختلفة لكل شخص

هذه يمكنك فعلها بسهولة .. قبل مناداة الدالة التي ذكرتها .. قم بتجميع البيانات التي تريد إرسالها للأشخاص في متغير واحد (بحيث تتغير الرسالة لكل شخص) ثم أرسله لدالة الواتسأب لإرسالها بالشكل النهائي .. ( يحتاجلك تتعلم هذه المهارات سهلة 😉👌🏼 )

19 دقائق مضت, محمد احمد لطفى said:

اضافة تم ارسال الرسالة او لم يتم ارسال الرسالة لنعرف من تم ارسال الرساله له 

هذه لا علم لي بها بعد .. 🙂 

[محمد احمد لطفى]

جزاك الله خيراً أستاذى @Moosak

تمام بارك الله فيك تم تغيير الرسالة باسم كل شخص

[محمد احمد لطفى]

أستاذى @Moosak

ممكن بعد اذنك تعدلى على النموذج ده 

علشان اعمل استعلام الحاق حذفت جدول GroupsTable  

التعديل على نموذج ارسال رسالة جماعية حيث تم عمل خلية وهمية IDMain  لاكتب بها رقم لكى يتم الارسال

ارجو التعديل بحيث لا يكون مرتبط بخلية IDMain 

والتعديل أيضا على الكود

 

Private Sub SF_Enter()
If IsNull(Me.IDMain) Then Me.Msg = " "
Me.Refresh
End Sub

ربنا يبارك فيك ويحفظك

 

__مرسال الواتسأب.accdb

[Eng.Qassim]

عمل رائع استاذ @Moosak...الله يبارك بعلمك ورزقك

لكن بودي ان تفكر معي قليلا ..لان بصراحة يقل تركيزي في شهر رمضان ..

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

الموضوع يصبح ممل بالنسبة لليوزر

[abouelhassan]

شكر وتقدير واحترام من القلب 

[ابوخليل]

الله عليك استاذنا  @Moosak المبدع

التخلص من اكسبلورر هذا علم وفن لوحده

والاوامر البرمجية المختصرة مذهلة

تعجز الأنامل عن الكتابة لتعطيك ما تستحقه من شكر وتقدير وثناء

فجزاك الله عن اخوتك خير الجزاء  .. وجعلها صدقة جارية لك ولوالديك .

[Moosak]

12 ساعات مضت, محمد احمد لطفى said:

ارجو التعديل بحيث لا يكون مرتبط بخلية IDMain 

ألغ هذا الجزء من الكود أخي محمد : 🙂 

[Moosak]

13 ساعات مضت, Eng.Qassim said:

عمل رائع استاذ @Moosak...الله يبارك بعلمك ورزقك

لكن بودي ان تفكر معي قليلا ..لان بصراحة يقل تركيزي في شهر رمضان ..

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

الموضوع يصبح ممل بالنسبة لليوزر

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

نعم عمي قاسم بالضبط .. تحفظ الملف PDF بجانب البرنامج بشكل مؤقت .. ثم ترسل الرابط لدالة إرسال الواتسأب .. وبعد الإرسال تحذف الملف

صحيح أن الموضوع يأخذ وقت لو كانت قائمة المرسل إليهم كبيرة .. ولكن هذا ما توصلنا إليه إلى الآن .. ولعله تتكرم علينا شركة الواتسأب بدوال API مباشرة للإرسال في النسخة المجانية .. 🙂 

 

وشخصيا استخدمت هذه الطريقة في أحد برامجي .. وهذا بشكل مختصر الكود الذي استخدمه :

 

Dim SaveToPath As String
Dim SaveFullName As String

    SaveToPath = CurrentProject.Path & "\"
    SaveFullName = SaveToPath & "ReportName.pdf"
    
    DoCmd.OutputTo acOutputReport, "ReportName", "*.pdf", SaveFullName, False, , , acExportQualityPrint

SendToWhatsApp "PhoneNumber", "الرسالة", SaveFullName, Document

    Kill SaveFullName
'    MsgBox "      تم الإرســــــال           ", vbMsgBoxRight, ""

 

 

11 ساعات مضت, ابوخليل said:

الله عليك استاذنا  @Moosak المبدع

التخلص من اكسبلورر هذا علم وفن لوحده

والاوامر البرمجية المختصرة مذهلة

تعجز الأنامل عن الكتابة لتعطيك ما تستحقه من شكر وتقدير وثناء

فجزاك الله عن اخوتك خير الجزاء  .. وجعلها صدقة جارية لك ولوالديك .

 

عمي أبو خليل كلماتك هي وسام فخر واعتزاز لتلميذكم الصغير 🙂 

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

 

 

[ابوخليل]

33 دقائق مضت, Moosak said:

 

نعم عمي قاسم بالضبط .. تحفظ الملف PDF بجانب البرنامج بشكل مؤقت .. ثم ترسل الرابط لدالة إرسال الواتسأب .. وبعد الإرسال تحذف الملف

صحيح أن الموضوع يأخذ وقت لو كانت قائمة المرسل إليهم كبيرة .. ولكن هذا ما توصلنا إليه إلى الآن .. ولعله تتكرم علينا شركة الواتسأب بدوال API مباشرة للإرسال في النسخة المجانية .. 🙂 

 

المشكلة من شركة اكسس لا يوجد آلية لاارسال التقرير مباشرة كصورة

انا عملت خطوة تسبق الارسال من اجل عيون واتساب

برنامجي عبارة عن نتائج طلبة : درجة وتقدير  .. وهي عملية مستمرة كل اسبوع

عملت زر في نموذج الارسال يحفظ جميع التقارير التي ينطبق عليها الشرط  بجانب القاعدة  ومن ثم تظهر الروابط امام الطلاب في الفورم

وبعد الارسال يتم حذفها

كذا افرد هذه الحركة في اجراء يخصها ولا اضعها داخل كود الارسال

[طاهر الوليدي]

عمل جميل ورائع واختصر الكواد فسلمت اناملك وجزاك الله خيرا

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

[أبو امين]

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

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

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

[Moosak]

2 ساعات مضت, طاهر الوليدي said:

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

اللهم آمين يارب العالمين🌹

 أخي طاهر هنا شرحت طريقة إرسال تقرير من الأكسس مباشرة :

 

 

2 ساعات مضت, أبو امين said:

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

بارك الله فيك أخي أبو أمين 🙂

طريقة الإرسال التي ذكرتها هي نفس طريقة الإرسال الجماعي التي في البرنامج .. الأرقام مخزنة في الجدول ويرسل لها جميعها مرة واحدة ..

والدالة التي أعطيتكم إياها هي الأداة التي يمكنك أن تبدع بها في كيفية إرسال الرسائل بآلاف الطرق والكيفيات المختلفة حسب كيفية عمل برنامجك الخاص.. 😉

[qathi]

بارك الله فيك

[أبو امين]

شكرا استاذي : 

هل بالامكان منع برنامج الواتس من الظهور لانه مقلق كثيرا 

[Moosak]

53 دقائق مضت, أبو امين said:

شكرا استاذي : 

هل بالامكان منع برنامج الواتس من الظهور لانه مقلق كثيرا 

مع هذه الطريقة غير ممكن للأسف ..

 

[أبو امين]

بوركت استاذ 

شكرا ربي اينور دربك 

[طاهر الوليدي]

في 31‏/3‏/2023 at 17:29, Moosak said:

طاهر

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

 

[Moosak]

29 دقائق مضت, طاهر الوليدي said:

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

هذه أفكار يمكنك أن تتفنن فيها كيفما تشاء 🙂

[طاهر الوليدي]

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

[حمدى الظابط]

دينامو الاكسيس استاذ موسى أكن لك كل الاحترام لمجهودك الملحوظ ومساعدتك للجميع واخلاصك فى إيجاد حلول تساهم فى انتهاء المبرمجين من أعمالهم بصورة مرضية ولا انسى الشكر لجميع الخبراء والاعضاء والقائمين على إبقاء منتدى اوفيسنا هو الافضل على مستوى العالم العربى من حيث العلم والتعليم واحترام الجميع @للجميع

وكل عام وحضرتك بخير 

 

[Mohameddd200300]

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