قمت بعمل برنامج لحجز الاجازات للموظفين في الشركة التي اعمل بها
وهذا البرنامج يقوم بارسال بريد الكتروني عن طريق برنامج MS outlook الى المشرف المباشر بعد تقديم طلب الحجز
وكنت سابقا استخدم كود موجود لديكم في المنتدى ولكن هذا الكود يقوم بالارسال بعد اظهار اشارة تحذير حيث ينبغى على المستخدم اختيار خيار Allow حتى يسمح للبرنامج بالارسال
وانا حاليا اريد استخدام الكود التالي الذي من المفترض ان يقوم بالارسال بدون اظهار رسالة التحذير
ولكن عند تنفيذ الكود يظهر الخطأ التالي
run-time error '438'
object doesn't support this property or method
مع العلم انني قد اضفت microsft outlook 12.0 object library الى references
ارجو منكم مساعدتي بالتعديل المناسب الذي يجعل هذا الكود يعمل
والكود هو على الشكل التالي
Option Explicit
Private Sub Command1_Click()
Dim blnSuccessful As Boolean
Dim strHTML As String
strHTML = "<html>" & _
"<body>" & _
"My <b><i>HTML</i></b> message text!" & _
"</body>" & _
"</html>"
blnSuccessful = FnSafeSendEmail("myemailaddress@domain.com", _
"My Message Subject", _
strHTML)
If blnSuccessful Then
MsgBox "E-mail message sent successfully!"
Else
MsgBox "Failed to send e-mail!"
End If
End Sub
Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean
Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute
objExplorer.Close
Set objNameSpace = Nothing
Set objExplorer = Nothing
End If
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing
FnSafeSendEmail = blnSuccessful
End Function