Othmaaan قام بنشر سبتمبر 26, 2012 مشاركة قام بنشر سبتمبر 26, 2012 السلام عليكم ورحمة الله وبركاته أعضاء منتدى أوفيسنا الكرام من لديه الخبرة لتعديل الكود التالي فليتفضل مشكوراً المطلوب / تغير وظيفة الكود بحيث أنه يرفق ملف بصيغة pdf ويرسلة عن طريق الايميل بدل صفحة html التي هو عليها الأن ؟؟؟ تقبلوا خالص تحياتي أرجوا من خبراء الويب إفاااااااادتي علماً بأن الكود بمرمجة الاستاذ أحمد صالح Option Explicit Function Send_Mail(mailto As String) Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Email@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "******" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With With iMsg Set .Configuration = iConf .To = mailto .From = """Othman"" " .Subject = "Medical Supply" .CreateMHTMLBody ThisWorkbook.Path & "\test.html" .Send End With End Function Sub mas() On Error Resume Next Dim n As Integer For n = 2 To 31 If Range("b" & n & "").Value = "" And Date - Range("a" & n & "").Value > 14 Then If Range("c" & n & "").Value <> "" Then Kill ThisWorkbook.Path & "\test.html" generatehtml (n) Send_Mail (Range("c" & n & "").Value) Range("d" & n & "").Value = "Êã ÇáÅÑÓÇá" End If End If Next n MsgBox "Êã ÅÑÓÇá ÌãíÚ ÇáÑÓÇÆá" End Sub Function generatehtml(rw As Integer) Dim fs As Object Dim A As Object Dim FileName As String FileName = ThisWorkbook.Path & "\test.html" Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(FileName, True) A.WriteLine (" [size=6] [right]ÚÒíÒí : [color=red]" & Range("F" & rw & "").Value & "[/color] äÝíÏ ÓíÇÏÊßã ÚáãÇ ÈÃä : ÇáãÚÇãáÉ ÑÞã : " & Range("E" & rw & "").Value & " æÇáãÄÑÎÉ ÈÊÇÑíÎ : " & Format(Range("a" & rw & "").Value, "yyyy/mm/dd dddd") & " ãÊÃÎÑÉ æÊÓÊæÌÈ ÇáÑÏ åÐÇ ááÚáã æÇÊÎÇÐ ÇááÇÒã ãÚ ÊÍíÇÊ : [color=green]ÇÓã ÔÑßÊß[/color][/size][/right] ") A.Close End Function رابط هذا التعليق شارك More sharing options...
Othmaaan قام بنشر سبتمبر 26, 2012 الكاتب مشاركة قام بنشر سبتمبر 26, 2012 (معدل) VBA.txt تم تعديل سبتمبر 26, 2012 بواسطه Othmaaan رابط هذا التعليق شارك More sharing options...
Othmaaan قام بنشر سبتمبر 27, 2012 الكاتب مشاركة قام بنشر سبتمبر 27, 2012 مرحباً لا أتوقع أن هذا الكود والتعديل عليه يصعب على عباقرة هذا المنتدى ,,, أشكر لكم إتاحة الفرصة لي ... ودمتم بود ... رابط هذا التعليق شارك More sharing options...
Othmaaan قام بنشر سبتمبر 27, 2012 الكاتب مشاركة قام بنشر سبتمبر 27, 2012 (معدل) تـــــــــــــــم حـــــــل الـــمـــشــكـــلــة والـــــــحــمـــدلله تم تعديل سبتمبر 27, 2012 بواسطه Othmaaan رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.