ارسال رساله الي الايميل بانتهاء المده

[أيهاب ممدوح]

الاخوة الكرام

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

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

بدون اتو لوك

الي الايميل مباشرة

بمجرد فتح الملف يعني في صفحه الحدث

مرفق ملف

email.zip

[أيهاب ممدوح]

للرفع

[أيهاب ممدوح]

للرفع

[أيهاب ممدوح]

للرفع

[أيهاب ممدوح]

للرفع

[ibn_egypt]

أخى الفاضل أ.ايهاب

 

أولاً : الملف المرفق ليس له علاقة بالايجارات وانتهائها وخلافه فهو مجموعة موظفين ومكتوب به ارسال ايميل لبريد الموظف اذا انتهت الرخصة او الاقامة وغيرها

 

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

 

emp19811@gmail.com

والثاني

emp19812@gmail.com

 

وهكذا

 

وعلى افتراض ان البريد الذي سترسل من خلاله الرسائل هو Ibn_Egypt@gmail.com >> والباسورد الخاصة به هي A_123456789  يكون الكود بهذا الشكل

Sub btnSendEmail()
On Error GoTo 1
Dim Mail As New Message
Dim ID, Licence As Boolean
Dim Config As Configuration: Set Config = Mail.Configuration
Dim LR As Long
Dim i As Integer
    
    
LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LR
    If Range("D" & i).Value < Date Or Range("C" & i).Value < Date Then
      If Range("E" & i).Value = "" Then
       Config(cdoSendUsingMethod) = cdoSendUsingPort
       Config(cdoSMTPServer) = "smtp.gmail.com"
       Config(cdoSMTPServerPort) = 25
       Config(cdoSMTPAuthenticate) = cdoBasic
       Config(cdoSMTPUseSSL) = True
       Config(cdoSendUserName) = "Ibn_Egypt@gmail.com"
       Config(cdoSendPassword) = "A_123456789"
       Config.Fields.Update

       Mail.To = Range("A" & i).Value & "@gmail.com"
       Mail.from = Config(cdoSendUserName)
       ID = False
       If Range("C" & i).Value < Date Then ID = True
    
       Licence = False
       If Range("D" & i).Value < Date Then Licence = True
       
       If ID = True Then
        Mail.Subject = "انتهاء البطاقة"
        Mail.HTMLBody = "انتهاء البطاقة بتاريخ" & Format(Range("C" & i).Value, "yyyy/m/d") & "يرجي التواصل مع أقرب مكتب تجديد"
       End If
    
       If Licence = True Then
        Mail.Subject = "انتهاء الرخصة"
        Mail.HTMLBody = "انتهاء الرخصة بتاريخ" & Format(Range("D" & i).Value, "yyyy/m/d") & "يرجي التواصل مع أقرب مكتب تجديد"
       End If
       
       Mail.Send
      MsgBox "تم ارسال البريد بنجاح الى الموظف" & " " & Range("A", i).Value, vbOKOnly + vbInformation, "تم الارسال"
       Range("E" & i).Value = "تم التنبيه وارسال بريد"
     End If
     End If
Next
1 End Sub

في الكود السابق لابد ان تعدل البريد Ibn_Egypt@gmail.com... بالبريد الخاص بك وكذلك كلمة المرور اسفله الى كلمة المرور الصحيحة للبريد المكتوب

 

كما انه يلزمك ايضا تفعيل هذه المكتبة من محرر الأكواد تختار Tools ثم References ,وتحدد علامة صح على المكتبة الموجودة بالصورة التى امامك

 

 

 

ولكى تجعل الكود يعمل تلقائيا بمجرد فتح الملف .. يتم وضع هذا الامر في حدث فتح الملف

Private Sub Workbook_Open()
btnSendEmail
End Sub

مرفق ملف ومن اراد من الاخوة الأعضاء استخدامه يرجي التأكد من تغيير البريد في الكود وكذلك كلمة المرور وتفعيل المكتبة ... الكود مجرب ويعمل بنجاح والايميلات السابقة emp19811@gmail.com >>> emp19812@gmail.com حقيقية

 

تحياتي  

email.rar

[KHMB]

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

الاستاذ الفاضل القدير احمد ابن مصر

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

طيب هل هناك إمكانية لجعلة يقبل الارسال لاي موفر خدمة البريد مثال ان تضيف مثلا :

Mail.To = Range("A" & i).Value & "@gmail.com" OR  Mail.To = Range("A" & i).Value & "@yahoo.com" OR.... Etc

[ابو فارس2013]

مهندسنا الغالي ماشاء الله شغل روعة

 

بتعرف ما بقدر اشوف شغلك وما استفاد منه هههه

 

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

 

سؤال هل لو عدلت من الداخل سرفر gmail الى سرفر اخر يعمل؟

 

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

[ibn_egypt]

اخوانى الأفاضل

 

اهم شئ بالموضوع على الاطلاق هى تزبيط اعدادات البريد الذي تتم من خلاله ارسال الرسائل .. فنلاحظ بالكود الماضي هذه الأسطر وهى الخاصة بإعدادات بريد ال Gmail حيث أن البريد الذي تتم من خلاله ارسال الرسائل هو Ibn_Egypt@gmail.com

Config(cdoSendUsingMethod) = cdoSendUsingPort
       Config(cdoSMTPServer) = "smtp.gmail.com"
       Config(cdoSMTPServerPort) = 25
       Config(cdoSMTPAuthenticate) = cdoBasic
       Config(cdoSMTPUseSSL) = True
       Config(cdoSendUserName) = "Ibn_Egypt@gmail.com"
       Config(cdoSendPassword) = "A_123456789"
       Config.Fields.Update

واذا كان البريد الذي تتم من خلاله ارسال الرسائل هو بريد ياهو على سبيل المثال والايميل الذي تتم من خلاله ارسال الرسائل Ibn_Egypt@yahoo.com لابد من تغيير الإعدادات السابقة بالإعدادات التالية

Config(cdoSendUsingMethod) = cdoSendUsingPort
       Config(cdoSMTPServer) = "smtp.mail.yahoo.com"
       Config(cdoSMTPServerPort) = 465
       Config(cdoSMTPAuthenticate) = cdoBasic
       Config(cdoSMTPUseSSL) = True
       Config(cdoSendUserName) = "Ibn_Egypt@yahoo.com"
       Config(cdoSendPassword) = "A_123456789"
       Config.Fields.Update

اما بخصوص سؤال اخى الفاضل ابا الحسن ممكن تعدل سطر الكود وتجعله هكذا

Mail.To = Range("A" & i).Value

وبالخلايا اكتب البريد كامل وليكن aa@yahoo.com أو mm@gmail.com أو أى بريد اخر تريده .. الملف المرفق سيوضح لك الفكرة

 

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

 

تحياتي  

email.rar

[أيهاب ممدوح]

السلام عليكم

اشكرك اخي ibn_egypt

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

ولدي ايضا الكود ارسال الخاص بالاستاذ ابو تراب الذي يرسل اشعار انتهاء البطاقه او الرخصه

فلو تكرمت عمل الكود علي الملف المرسل .. واسف علي رفع الملف الخطأ

شكرااااا

ehab.rar

[KHMB]

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

استاذي العزيز اشكرك بعنف

جزاك الله خير وفي ميزان حسناتك

لن انساك وبرنامجك شغال معاي 100%  نفعني في عملي الشخصي

[ibn_egypt]

السلام عليكم

اشكرك اخي ibn_egypt

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

ولدي ايضا الكود ارسال الخاص بالاستاذ ابو تراب الذي يرسل اشعار انتهاء البطاقه او الرخصه

فلو تكرمت عمل الكود علي الملف المرسل .. واسف علي رفع الملف الخطأ

شكرااااا

 

اخى الفاضل أ.ايهاب

 

أولاً: ما نوع البريد الذي سيتم من خلاله ارسال الرسائل للناس .. Yahoo --Gmail ام غيرها لانك لو تريد الارسال من بريد من نوع اخر يتطلب لدينا معرفة SMTP Server  وكذلك ال SMTP SERVER Port لهذا البريد

 

ثانيا .. اين ايميلات الناس في الملف المرفق

 

ثالثا ماهو شرط ارسال رسالة البريد ... برجاء قراءة المشاركات السابقة ومعرفة آلية عمل الارسال والإجابة على ما سبق

 

تحياتي  

[يوسف السيد]

الاستاذ الفاضل : ابن مصر

الكود ولا أرووووووووووووووع

تم تجربته بنجاااااااااااااااااااااح

[أيهاب ممدوح]

اخي الكريم

ابن مصر

لدي هذا الكود مسبقا لارسال ملف الي الياهو

والموضوع هو . ان الملف المرفق هو الايجارات والمستندات والاقامات

اريد عندما يكتب كلمه مطلوب في العمود D يقوم بارسال رساله الي الايميل يكون العنوان اشعار والنص هو ( اشعار انتهاء الاقامه او الايجار او المستند حسب النوع الموجود في العمود B في تاريخ الموجود في العمودF متبقي عليه المده الموجوده في العمودG

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

الايميل المطلوب الارسال اليه EHABMAMDOUH28@YAHOO.COM

الايميل المرسل منه اي شئ

وشكرا

[أيهاب ممدوح]

اخي ابن مصر

الاشعار يرسل الي ايميل واحد فقط

شكرا

[ibn_egypt]

اخى الفاضل أ.إيهاب

 

تفضل هذا الكود الذي تريده مع مراعاة تغيير الايميل المكتوب بالكود الى الايميل الحقيقي لك وكتابة كلمة المرور الخاصة به .. والخلية A1 مكتوب بها البريد الذي تتم ارسال الرسائل اليه

Sub btnSendEmail()
On Error GoTo 1
Dim Mail As New Message
Dim Config As Configuration: Set Config = Mail.Configuration
Dim LR As Long
Dim i As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("الايجارات")
LR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
With ws
For i = 4 To LR
    If Trim(.Cells(i, 4).Value) = "مطلوب" And .Cells(i, 8).Value = "" Then
       Config(cdoSendUsingMethod) = cdoSendUsingPort
       Config(cdoSMTPServer) = "smtp.mail.yahoo.com"
       Config(cdoSMTPServerPort) = 465
       Config(cdoSMTPAuthenticate) = cdoBasic
       Config(cdoSMTPUseSSL) = True
       'Change To Your Real yahoo Mail
       Config(cdoSendUserName) = "Ibn_Egypt@yahoo.com"
       'Change To Your Real Password
       Config(cdoSendPassword) = "A_123456789"
       Config.Fields.Update

       Mail.To = .Range("A1").Value
       Mail.from = Config(cdoSendUserName)
       Mail.Subject = "اشعار"
       Mail.TextBody = "انتهاء" & " " & .Cells(i, 2).Value & " " & " للسيد " & .Cells(i, 1).Value & " " & "بتاريخ " & .Cells(i, 6).Value & " متبقي عليها " & .Cells(i, 7).Value
       
       Mail.Send
       MsgBox "تم ارسال البريد بنجاح"
       .Cells(i, 8).Value = "تم التنبيه وارسال البريد"
     End If
Next
End With
Application.ScreenUpdating = True
1 End Sub

مرفق الملف للتوضيح

 

تحياتي  

ehab.rar

[أيهاب ممدوح]

اخي ابن مصر

الكود يعمل جيدا جدااااااااااااااااا

يوجد مشكله عندالارسال

عنوان الرساله (؟؟؟؟؟؟؟؟؟؟؟؟؟) يظهر علامات استفهام

وكذلك نص الرساله ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ علامات استفهام

[أيهاب ممدوح]

Email.BodyPart.Charset = "UTF-8"

الاخوة الكرام

اخي ابن مصر

لقد قرأت كود الاخ ابو تراب لأرسال رساله الي الايميل بواسطه الاوتولوك

وكان قد وضع هذا السطر

حاولت ان اضيفه لكن لا فائده فهل من مساعده

[ibn_egypt]

اخى الفاضل أ.إيهاب 

 

اجعلها هكذا .. هتزبط معاك ان شاء الله

Mail.BodyPart.Charset = "UTF-8"

مرفق الملف للتوضيح

 

تحياتي  

ehab.rar

[KHMB]

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

شكرا الاستاذ احمد ابن مصر اهذا النموذج الثاني شغال 100%

جزاك الله خير

[أيهاب ممدوح]

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

الكود ممتاز واللغه اصبحت ممتازة

بس فيه طلب بسيط

هو القائمه فيها اسماء محلات واسماء اشخاص

ونص الرساله فيه لقب السيد الذي يطلق علي الاشخاص

نرجوا اضافه كلمه محل اذا كان الايجار و السجل مطلوب

الايجار والسجل للمحلات

والاقامه للأشخاص

وشكرا

[ibn_egypt]

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

الكود ممتاز واللغه اصبحت ممتازة

بس فيه طلب بسيط

هو القائمه فيها اسماء محلات واسماء اشخاص

ونص الرساله فيه لقب السيد الذي يطلق علي الاشخاص

نرجوا اضافه كلمه محل اذا كان الايجار و السجل مطلوب

الايجار والسجل للمحلات

والاقامه للأشخاص

وشكرا

 

اخى ايهاب 

 

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

 

في حالة لو اقامه نص الرسالة عاوزها ".........................."

في حالة سجل نص الرسالة يكون " .............................."

في حالة محل نص الرسالة يكون "................................"

 

تحياتي  

[أيهاب ممدوح]

اخي الكريم

نفس النص هو هو لجميع الحالات

لكن عندما تكون اقامه يكون انتهاء الاقامه السيد...... بتاريخ ..... ومتبقي عليها.....

لكن عندما تكون ايجار يكون انتهاء ايجار للمحل .... بتاريخ ..... ومتبقي عليها ....

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

لاحظ ان الفرق الوحيد هو ( السيد عند انتهاء الاقامه لانها تخص شخص)

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

الخلاف فقط للمحل و للسيد

شكرا

[أيهاب ممدوح]

للرفه

[ibn_egypt]

اخى الفاضل

 

تفضل الملف المرفق .. لربما به طلبك .. وعذرا للتأخير

 

تحياتي  

ehab.rar