۩◊۩ أبو حنين ۩◊۩ قام بنشر فبراير 18, 2017 مشاركة قام بنشر فبراير 18, 2017 السلام عليكم الساده الكرام .. ارجو المساعده فى تعديل كود لاخ الجليل ياسر ابو البراء .. جذاه الله كل الخير والتقدير الكود يقو على ارسال نسخه بيانات وليس المعاادلان من الشيت الفعال اميل - المطلوب تغير الشيت الفعال الى اسم شيت وليكن شيت a&b اى نسخ الشيت a & b بيانات وارساله اميل واختيار ايضا اسم المصنف الجديد الذى يتم ارساله اميل ... يتم كتابته داخل الكود هلى يمكن المساعده فى ذلك Option Explicit Sub Mail_ActiveSheet_Using_Outlook() Dim fileExtStr As String Dim fileFormatNum As Long Dim sourceWb As Workbook Dim destWb As Workbook Dim tempFilePath As String Dim tempFileName As String Dim outApp As Object Dim outMail As Object With Application .ScreenUpdating = False .EnableEvents = False End With Set sourceWb = ActiveWorkbook ActiveSheet.Copy Set destWb = ActiveWorkbook With destWb If Val(Application.Version) < 12 Then fileExtStr = ".xls": fileFormatNum = -4143 Else Select Case sourceWb.FileFormat Case 51: fileExtStr = ".xlsx": fileFormatNum = 51 Case 52: If .HasVBProject Then fileExtStr = ".xlsm": fileFormatNum = 52 Else fileExtStr = ".xlsx": fileFormatNum = 51 End If Case 56: fileExtStr = ".xls": fileFormatNum = 56 Case Else: fileExtStr = ".xlsb": fileFormatNum = 50 End Select End If End With 'Change All Cells In The Worksheet To Values If You Want With destWb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False '====================================== 'Save The New Workbook/Mail It/Delete It tempFilePath = Environ$("temp") & "\" tempFileName = Replace(sourceWb.Name, ".xlsm", "") Set outApp = CreateObject("Outlook.Application") Set outMail = outApp.CreateItem(0) With destWb .SaveAs tempFilePath & tempFileName & fileExtStr, FileFormat:=fileFormatNum On Error Resume Next With outMail .To = "aaa@.com" 'Change Email .CC = "aaa@.com" .BCC = "aaa@.com" .Subject = "بدلات " .Body = " مع تحيات ..إدارة الشئون الادارية )- 8240" .Attachments.Add destWb.FullName .Send End With On Error GoTo 0 .Close savechanges:=False End With 'Delete The File You Have Sent Kill tempFilePath & tempFileName & fileExtStr Set outMail = Nothing Set outApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 18, 2017 مشاركة قام بنشر فبراير 18, 2017 وعليكم السلام يرجى وضع الملف الذي توصلت إليه ووضع الرابط ليستفيد الجميع تقبل تحياتي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان