تعديل كود رائع

[عزيز عرابي]

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

 

مرفق ملف فيه كود رائع لارسال ايميلات بواسطة برنامج الاوتلوك , توجد مشكلة في الكود و هي نص الرسالة يتم أخذه من خلية و احدة فقط

 

و أنا اريد نص الايميل او ارسالة أن يتم أخذه من عدة خلايا و لتكن من F1 و حتى I5  أي (F1:I5)

 

 

Sub CreateMail()

 

    Dim objOutlook As Object

    Dim objMail As Object

    Dim rngEntry As Range

    Dim rngEntries As Range

 

    Set objOutlook = CreateObject("Outlook.Application")

    Set rngEntries = ActiveSheet.Range("B2:B5")

    

    For Each rngEntry In rngEntries

        Set objMail = objOutlook.CreateItem(0)

        With objMail

            .To = rngEntry.Value

            .CC = rngEntry.Offset(0, 4).Value

            .Subject = rngEntry.Offset(0, 1).Value

            .Body = rngEntry.Offset(0, 2).Value

            .Attachments.Add rngEntry.Offset(0, 3).Value

            .Send '.Display or .Save

        End With

    Next rngEntry

    

    Set objOutlook = Nothing

    Set objMail = Nothing

    Set rngEntry = Nothing

    Set rngEntries = Nothing

 

End Sub

 

 

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

 

EMAIL MULTIPLE ATTACHMENTS.rar

[احمدزمان]

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

 

اخي عزيز

 

استخدم الدالة CONCATENATE لجمع النصوص في خلية واحدة

وحيث ان نص الرسالة في الخلية D

اذا

CONCATENATE(F6;G6;H6;I6)

وبطريقة اخرى

اذا اردت نص الرسالة ان يكون كل خلية في سطر جديد

=CONCATENATE(F7;CHAR(10);G7;CHAR(10);H7;CHAR(10);I7)

والله اعلم

[عزيز عرابي]

الاستاذ احمد زمان الغالي تسم ما قصرت لكن الكود توقف عن العمل و لم يعمل بعد اضافة اقتراحكم

 

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

[احمدزمان]

اخي الفاضل

 

استبدل

            .Body = rngEntry.Offset(0, 2).Value

بــــ

            .Body = rngEntry.Offset(0, 2).Text

وجرب

[عزيز عرابي]

أستاذ احمد زمان الغالي

 

 

 .Body = rngEntry.Offset(0, 2).Text

 

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

 

و لكم الشكر الجزيل

[احمدزمان]

اخي الحبيب عزيز

اذا 

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

بمعنى اضافة الدوال الى الورقة وليس اضافة الى الكود للإرسال

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

 

اخي عزيز

 

استخدم الدالة CONCATENATE لجمع النصوص في خلية واحدة

وحيث ان نص الرسالة في الخلية D

اذا

CONCATENATE(F6;G6;H6;I6)

وبطريقة اخرى

اذا اردت نص الرسالة ان يكون كل خلية في سطر جديد

=CONCATENATE(F7;CHAR(10);G7;CHAR(10);H7;CHAR(10);I7)

والله اعلم

 

 

واذا اردت اضافة لكود VB نفسة فهنا تستخدمOffset مع علامة الدمج &

 

مع التحية

[عزيز عرابي]

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

 

تم استخدام هذا الكود

 

 

Sub CreateMail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngSubject As Range
    Dim rngCC As Range
    Dim rngBody As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("D18")
        Set rngCC = .Range("E18")
        Set rngSubject = .Range("F18")
       
       Range("A1:G13").Select
    Selection.Copy
      
        Set rngBody = .Range("I22")
    End With

    With objMail
        .To = rngTo.Value
        .CC = rngCC.Value
        .Subject = rngSubject.Value
        .Body = rngBody.Value
        .Display 'Instead of .Display, you can use .Send to send the email _
                    or .Save to save a copy in the drafts folder
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngCC = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing

End Sub

 

 

[احمدزمان]

الحمد لله انك وصلت لماتريد

 

بالتوفيق

[عزيز عرابي]

اشكرك استاذ احد زمان على مرورك الكريم و مساعدتكم