كود ماكرو لحفظ الملف باسم معين وارساله عبر الايميل

[عبدالرحمن بدوى]

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

تحية طيبة وبعد

انا أريد كود ماكرو يقوم بالوظائف الآتية

1- يقوم بحفظ نسخة من الملف كله وليس شيتات معينة باسم معين كما بالمرفقات وليكن مثلا work وبالطبع يكون الحفظ باسم الكلام الموجود فى هذه الخلية b4 ايا كان هو  كما هو فى الملف المرفق و فى امتداد معين وليكن مثلا 

F:\Programes\Windows

2- يقوم بارسال نسخة من الملف كله عبر برنامج الإيميل الموجود على الجهاز (وللعلم عندى مسطب برنامج lotus notes) عشان لو هنحدد اسم البرنامج ولا حاجة

على ان يكون العنوان باسم يؤخذ من الملف نفسه على سبيل المثال هنا يكون العنوان هو الكلام المكتوب فى الخلية c9 وهو هنا اسمه results of work 200 

 

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

1.rar

[عبدالرحمن بدوى]

انا وجدا هذا الكود على النت ولكن اريد التعديل عليه ليقوم بعمل المهام التى كتبتها فى الموضوع

Sub Mail_workbook_Outlook_2()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

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

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hello World!"
        .Attachments.Add wb2.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send   
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[۩◊۩ أبو حنين ۩◊۩]

اخى الكريم

اجد رد الا اللفاضل طارق محمود هو خير دليل

رجاء مراجعة الروابط التالية

http://www.officena.net/ib/index.php?showtopic=29748&st=0&p=148274&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry148274

أو

http://www.officena.net/ib/index.php?showtopic=32704&st=0&p=168449&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry168449

أو

http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156862&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156862

أو

http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156669&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156669

 

وستجد فيها إن شاء الله ماتريد وأكثر

[عبدالرحمن بدوى]

مبدئيا جزاكم الله خيرا على الإهتمام

سأراجع الروابط وإن شاء الله اجد فيها الحل

[عبدالرحمن بدوى]

اخى الكريم

اجد رد الا اللفاضل طارق محمود هو خير دليل

رجاء مراجعة الروابط التالية

http://www.officena.net/ib/index.php?showtopic=29748&st=0&p=148274&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry148274

أو

http://www.officena.net/ib/index.php?showtopic=32704&st=0&p=168449&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry168449

أو

http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156862&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156862

أو

http://www.officena.net/ib/index.php?showtopic=31030&st=0&p=156669&hl=%C5%D1%D3%C7%E1%20%C5%E3%ED%E1&fromsearch=1&#entry156669

 

وستجد فيها إن شاء الله ماتريد وأكثر

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

اخى الفاضل جزاكم الله خيرا

وقد وجدت ضالتى فى هذا الموضوع

http://www.officena.net/ib/topic/32704-إرسال-رسائل-بريدية-بمرفقات-عن-طريق-outlook/#entry168449

ولكن لى طلب للتعديل عليه ان كنت تستطيع مساعدتى

1- الملف يقوم بإلرسال معلومات معينة فى السبت الذى يتم اختياره 

ولكنى اريد ارسال نسخة من الملف كله (workbook) طبعا مع الإحتفاظ بالملف الأصلى

2- يقوم الكود بارسال رسالة بعنوان ثابت ولكنى اريد ان يرسلها بعنوان مقتبس من خلية محددة فى الملف

 

وجزاكم الله خيرا على الإهتمام