إضافة حلقة تكرارية لكود

[مداد_1423]

تحية طيبة للجميع وأدام الله عليكم لباس الصحة 

وبعد:-

في المرفق كود لإرسال إيميل بالآوتلوك يعمل بكفاءة على الصف 3

أريد حلقة تكرارية لكل صف إلى آخر صف

لأن الملف يحتوي في العادة على عشرة صفوف إلى خمسين صف .

Private Sub Send_Email()
  Dim OutApp    As Object
  Dim OutMail   As Object


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)

  With OutMail
    .to = Range("A3").Value
    .CC = Range("B3").Value
    .Subject = Range("C3").Value
    .HTMLBody = Range("D3").Value
    .Send
  End With

  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

إيميللات.xlsm

[الرائد77]

غير الى هذا الكود

  Dim OutApp    As Object
  Dim OutMail   As Object


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
  With OutMail
    .To = Range("A" & i).Value
    .CC = Range("B" & i).Value
    .Subject = Range("C" & i).Value
    .HTMLBody = Range("D" & i).Value
    .Send
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
  MsgBox Range("A" & i).Value
  Next i

 

إيميللات.xlsm

[مداد_1423]

أستاذ: الرائد77

بارك الله في عمرك وصحتك ورزقك من حيث لا تحتسب

كثر الله من أمثالك ونفع بك 

هنيئا لك زكاة العلم 

جزاك الله خيرا 

تحياتي يا كبير

[مداد_1423]

أستاذي ... بعد الرجوع إلى العمل وتجربة الكود يرسل الإيميل الأول في صف رقم 3

وبعدين تظهر رسالة الخطأ ..

آسف على هذا الشيء ما كان ودي آخذ من وقتكم أكثر ولكن ما قدرت أحل المشكلة وإن شاء الله تكون بسيطة عليكم

 

 

[الرائد77]

تتفضل. الكود يعمل 100/100 بعد التعديل. تم التجربة

Sub Button3_Click()
  Dim OutApp    As Object
  Dim OutMail   As Object
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .To = Range("A" & i).Value
    .CC = Range("B" & i).Value
    .Subject = Range("C" & i).Value
    .HTMLBody = Range("D" & i).Value
    .Send
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
  MsgBox Range("A" & i).Value
  Next i
End Sub

 

إيميللات (1).xlsm

[مداد_1423]

يقول الرسول صلى الله عليه وسلم: (كان الله في عون العبد ما كان العبد في عون أخيه)ـ

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

ولك مني الدعاء والشكر أستاذي

بالله الله فيك وكثر من أمثالك ونفع بعلمك

 

تحياتي