مشكلة ظهور خطأ run time error -2146697208 (800c0008)

[hhez2005]

السلام عليكم

عندي ملف اكسل ارسال رسالة من الاكسل الى الواتس 

صار لي سنة وأموري ماشية مع الاكواد ، وفجأة طلعت لي هذه الرسالة مدري ايش المشكلة (مرفق)

[أ / محمد صالح]

هل تستعمل تطبيق واتساب للكمبيوتر

أعتقد هذا الكود لا يستعمل web.whatsapp

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

Sub whatsappme()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application") 
    IE.navigate "whatsapp://send?phone=0000000000&text=message"
    Application.Wait Now() + TimeSerial(0, 0, 5)
    SendKeys "~"
    Set IE = Nothing 
End Sub

مع استبدال الأصفار بالرقم المطلوب مع مفتاح الدولة 

وكلمة message بنص الرسالة 

بالتوفيق 

[أ / محمد صالح]

as you like كما تحب

ولكن استخدام كائن انترنت اكسبلورر افضل من الهايبر لينك

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

أعطيتك الكود لتقوم بتوظيفه كما تشاء 

ولكنك لا تريد

بالتوفيق 

[أ / محمد صالح]

لتوظيف الكود في ملفك يمكنك

حذف 8 اسطر من السطر الذي بدايته

obj.settext

إلى السطر قبل next

وضع بدلا منهم الكود الخاص بي مع وضع متغيراتك الخاصة بالرقم والرسالة

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application") 
IE.navigate "whatsapp://send?phone=" & contact & "&text=" & message
Application.Wait Now() + TimeSerial(0, 0, 5)
SendKeys "~"
Set IE = Nothing

مع التاكيد على احتواء الرقم على مفتاح الدولة

بالتوفيق

[hhez2005]

السلام عليكم

الكود يرسل فقط للارقام المسجلة اسماؤهم في الموبايل

لكن اغلب الاسماء الي عندي غير مسجلة اسماؤهم في الموبايل

ارجو تعديل الكود بجيث يرسل للارقام غير المسجلة اسماؤهم او الغير محفوظة في الموبايل مع العلم بأن ارقام الجوال والنصوص عبارة عن دوال vlookup مأخوذة من مصنف اخر في نفس الاكسل

[أ / محمد صالح]

اخي الكريم 

من أخبرك بهذا الادعاء 

الكود يعتمد على الرقم ونص الرسالة 

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

بالتوفيق 

[أ / محمد صالح]

في الكود الخاص بك

المتغير contact يأخذ قيمة الخلية وليس معادلتها 

المهم كما اخبرتك اكثر من مرة ان يكون الرقم بمفتاح الدولة 

[أ / محمد صالح]

من الصفر

يتم فتح برنامج واتس اب للكمبيوتر 

وقراءة رمز qr وتجهيز الاتصال بين واتس اب الكمبيوتر والموبايل

بعد فتح البرنامج وعمله

يتم فتح ملف الاكسل وتشغيل الكود 

بعد تشغيل الكود مباشرة تنشيط نافذة واتساب 

مع ملاحظة استمرار فتح تطبيق واتساب في الموبايل أثناء عملية الارسال

وعدم الضغط على اي شيء بالفارة او لوحة المفاتيح في برنامج واتساب الكمبيوتر 

لأن أخطر جزئية في هذا الأمر قيام الكود بالضغط على زر enter بعد كتابة نص الرسالة في مكانها

فإذا لم يكن المؤشر في مربع الرسالة لن يقوم بالارسال

بالتوفيق 

[أ / محمد صالح]

الكود عندي يعمل بصورة طبيعية جدا

ربما بسبب بطء الانترنت عندك مثلا

 

[hhez2005]

لا يعمل 

الملف في المرفقات وجرب بنفسك ممكن تكتشف الخطأ

 وحط ارقام جوال من عندك باللون الارزق في المصنف اسم (ورقة 1) عشان يظهر لك في الدالة vlookup اللي موجودة في المصنف الاخر بإسم (sheet1) 

Send Via Whatsapp للتجربة.rar

[أ / محمد صالح]

العمود contact والذي يفترض به ارقام الموبايل به صفر فقط

في sheet1

لان الكود عندك يقرأعمود contact  من جدول tbl

ومعظم العمود فارغ وهذا يظهر أخطاء في برنامج الواتس آب 

 

 

[hhez2005]

ادري انه صفر

انت بنفسك روح مصنف (ورقة١) وحط ارقام جوال من عندك 

وارجع لمصنف (sheet1) وبيطلع لك الارقام بسبب دالة vlookup

واضغط على الكود 

هتلاقي انه مش يعمل

[أ / محمد صالح]

شغال عادي جدا

بعد الضغط على الزر في اكسل قلت لك نشط برنامج الواتس علشان نص الرسالة يكتب تلقائيا ويتم الضغط على انتر

ولتفادي الصفوف الفارغة في نهاية الجدول يمكنك استعمال for next بدلا من جميع خلايا الجدول

بعدد الصفوف المطلوبة من 6 الى كذا

Sub WhatsApp()
Dim Contact As String
Dim Message As String
Dim n As Long

For n = 6 To 22
Contact = Cells(n, 8).Value
Message = Cells(n, 9).Value
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "whatsapp://send?phone=" & Contact & "&text=" & Message
Application.Wait Now() + TimeSerial(0, 0, 5)
SendKeys "~"
Set IE = Nothing
Next n
MsgBox "Done!"
End Sub

بالتوفيق 

[hhez2005]

نفس المشكلة .. لما اكتب الارقام بالكيبورد بدال استخدام دالة vlookup

يعمل ... اما بدالة vlookup لا يعمل ويظل السهم يدور  ... لما اضغط على debug  يطلع الخطأ باللون الاصفر في 

IE.navigate "whatsapp://send?phone=" & Contact & "&text=" & Message

لا اعلم ... هل هو لا يتعرف على الرقم بصيغة دالة او انه ينسخ الدالة

 

[أ / محمد صالح]

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

وظهور الخطأفي هذا السطر يعني تركيبة خلية الرقم

برنامج الواتس آب لك حلان فيه مع رقم الموبايل:

* إذا كان الرقم من نفس دولة رقم صاحب الحساب لا يحتاج الى كتابة مفتاح الدولة والصفر الاول من رقم الموبايل

فمثلا نحن في مصر مفتاح الدولة +2 ورقم الموبايل مثلا يبدأ ب 010 يتم كتابة 10 ثم بقية الرقم

* كتابة الرقم كاملا مع مفتاح الدولة (وهذا الذي أفضله لتفادي مشكلة كتابة الصفر قبل 10 مرتين) ويبدأ ب

+2010

أرجو أن يكون اتضح الامر

لاني جربت الكود في ملفك على رقمين بنفس نص الرسالة في ملفك وعمل بصورة طبيعية جدا

[أ / محمد صالح]

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

ملفك يعمل عندي بدون مشاكل حتى باستخدام  دوال vlookup 

لكن مع تعديل وهو تحديد الصفوف من 6 إلى كذا

على العموم هذه آخر محاولة مني على ملفك:

تم الاستغناء عن فتح برنامج الواتس آب عن طريق ارسال الرابط لمتصفح انترنت اكسبلوورر

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

جرب هذا ملف يرسل لأرقامي للتجربة

كل ما عليك فعله بالترتيب:

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

* فتح ملفك المرفق في هذه المشاركة والضغط على ارسال الرسائل 

* ترك الكود يفتح البرنامج ويكتب نص الرسالة ويضغط انتر بدون تدخل منك

بالتوفيق 

Send Via Whatsapp للتجربة.xlsm

[hhez2005]

عند نقل الكود للملف اكسل اخر نفس الاكسل المعدل اعلاه ، اكتشفت انه يأخذ نص الرسالة للاكسل المعدل 

وانا لا اريد النصوص في الاكسل المعدل بل اريد نصوص الملف الاكسل الاخر .. ولكن يأخذ نصوص المعدل ,, فما الحل؟

 

[أ / محمد صالح]

يبدو أن الكود بعد التعديل الأخير قد عمل معك

Sub WhatsApp()
Dim Contact As String, Message As String
Dim n As Long

For n = 6 To 7
Contact = Cells(n, 8).Value
Message = Cells(n, 9).Value
Shell "explorer ""whatsapp://send?phone=" & Contact & "&text=" & Message & """", vbNormalFocus
Application.Wait Now() + TimeSerial(0, 0, 5)
SendKeys "~"
Next n
MsgBox "Done!"
End Sub

الذي يهمنا لنجاح التجربة في أي ملف هو هذا السطر

For n = 6 To 7

الذي يحدد صفز البداية والنهاية لقائمة الأرقام والرسائل

وهذين السطرين

Contact = Cells(n, 8).Value
Message = Cells(n, 9).Value

وهما المتغير contact وفيه الرقم وهو في العمود الثامن H لنفس الصف

والمتغير message وهو في العمود التاسع I لنفس الصف

فإذا اختلف صف البداية والنهاية عن 6 و 7 يتم تغييره

وإذا اختلف عمود الرقم يتم تغييره وإذا اختلف عمود الرسالة في الملف الجديد يتم تغيير رقم 9 في متغيره

بالتوفيق

[hhez2005]

تم تغيير السطر التالي فقط

For n=6 to 55

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

ولكن اكتشفت انه يرسل نص الرسالة الذي في الاكسل A

مدري ليش؟

اتمنى فهمت علي

[أ / محمد صالح]

أشك انك نسخت الزر من الملف الأول للملف الثانى 

[hhez2005]

لا ، لم انسخ الزر .. سوف ارسل الملف على ايميلك الهوتميل المسجل في ملفك الشخصي ..مع العلم بأن بعض الاحيان لا يرسل بالترتيب

القصد لا يرسل ارقام الجوال بالترتيب ، مثلا يرسل الصف 8 والنص مختلف ايضا ويترك الصف 6 ... اوكيه ليه النص مختلف

 

[أ / محمد صالح]

يفضل إرفاق الملفات في الموضوع

[hhez2005]

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

واضغط الزر وجرب سترى بنفسك ان النص لا يرسل بالكامل .. وان يبدأ من رقم الجوال الثاني يعني مش بالترتيب

وفي حال رقم الجوال غير متوفر بمعني لا يوجد واتس اب لهذا الرقم ونفترض في الصف التاسع   يبدأ يخربط 

Send Via Whatsapp للتجربة.xlsm

 

[أ / محمد صالح]

أخي الكريم

الكود لا يحدد الملف مصدر الأرقام والرسائل

الكود يقرأ محتويات الصف السادس حتى الصف 55 في العمود 8 الذي اسمه H والعمود 9 والذي اسمه I من الشيت النشط

وبالنسبة لعدم وصول نص الرسالة كاملا

تم التغلب عليها بكتابة نص الرسالة في مربع الارسال تلقائيا وعدم إرسالها في الرابط

Sub WhatsApp()
Dim Contact As String, Message As String
Dim n As Long

For n = 6 To 7
Contact = Cells(n, 8).Value
Message = Cells(n, 9).Value
If Contact <> 0 And Message <> "" Then
Shell "explorer ""whatsapp://send?phone=" & Contact & """", vbNormalFocus
Application.Wait Now() + TimeSerial(0, 0, 5)
SendKeys Message
Application.Wait Now() + TimeSerial(0, 0, 3)
SendKeys "~"
Application.Wait Now() + TimeSerial(0, 0, 3)
End If
Next n
MsgBox "Done!"
End Sub

لاحظ تم حذف المتغير message من رابط الإرسال وكتابته عن طريق الأمر sendkeys

وبالنسبة لاحتمالية عدم وجود رقم تم وضع شرط

عدم فراغ خلية الرسالة وعدم وجود صفر فقط في خلية الرقم

بالتوفيق