لــخبراء الويب .........

[Othmaaan]

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

أعضاء منتدى أوفيسنا الكرام

من لديه الخبرة لتعديل الكود التالي فليتفضل مشكوراً

المطلوب / تغير وظيفة الكود بحيث أنه يرفق ملف بصيغة 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

[Othmaaan]

VBA.txt تم تعديل سبتمبر 26, 2012 بواسطه Othmaaan

[Othmaaan]

مرحباً

لا أتوقع أن هذا الكود والتعديل عليه يصعب على عباقرة هذا المنتدى ,,,

أشكر لكم إتاحة الفرصة لي ...

ودمتم بود ...

[Othmaaan]

تـــــــــــــــم حـــــــل الـــمـــشــكـــلــة والـــــــحــمـــدلله

تم تعديل سبتمبر 27, 2012 بواسطه Othmaaan