كودين كل واحد منهما يعمل وإذا دمجتهم يعمل واحد فقط << ترحيل PDF وإرسال على الإيميل

[مداد_1423]

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

عندي كودين الأول لترحيل حلقة متكررة إلى شيت 2 وحفظ الشيت الثاني PDF

والكود الثاني من تعديل الأستاذ (الرائد77)

عند دمج الكودين يطلع لي خطأ في السطر sned

بمعنى أن الترحيل إلى PDF يعمل تمام ولكن المشكلة ما قدرت أرسله على الإيميل الخطأ عند send

 

المطلوب :

1) تصحيح خطأ الإرسال بالإيميل

2) وإذا كان من الممكن استبدال سطر

    a = 1
    
    Do While a <= 4

 

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

For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row

 

الكود بالكامل

Sub Send_Payslip()

  Dim OutApp    As Object
  Dim OutMail   As Object
    
    a = 1
    
    Do While a <= 4
    
    EmpID = Sheet2.Range("A8").Offset(a, 0).Value
    Sheet3.Range("A8").Value = EmpID
    
    Filename = Sheet3.Range("A1").Value & ".pdf"
    Sheet3.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Filename
    
      Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .To = Range("A22").Value
    .Subject = Range("A1").Value
    .HTMLBody = Range("A1").Value
    .Attachments.Add (ThisWorkbook.Path & "\" & Sheet3.Range("A1").Value & ".pdf")
    .Send
  End With
  Set OutMail = Nothing
  Set OutApp = Nothing
    
        a = a + 1
        
        Loop

End Sub

تحياتي للجميع

إرسال إيملات pDF.xlsm

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

بالنسبة لمشكلة الإرسال فيبدو ان الإرسال يتم قبل أن يتم تصدير الملف pdf 

لذلك يمكنك استعمال أمر الانتظار قبل تنفيذ الكود الثاني لبعض الثواني باستعمال الأمر wait هكذا

Application.Wait DateAdd("s", 5, Now)

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

ضع سطر for بدلا من while 

وضع سطر next بدلا من زيادة المتغير a وبعده loop

بالتوفيق 

[مداد_1423]

جزاك الله خيرا يا أستاذنا (محمد صالح)

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

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