【seagull1985-QTP】利用outlook进行邮件发送并添加附件 - 51Testing软件测试论坛

'==========================================================================
' NAME: mail
' AUTHOR: heyl
' DATE : 2013-03-13
' Last Update :2013-07-24
' COMMENT:
'==========================================================================
Class MailEngine
Public objOutlook
Public objOutlookMsg
Public olMailItem
Private Sub Class_Initialize
' Create the Outlook object and the new mail object.
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
End Sub
Private Sub Class_Terminate
' Release the objects
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set olMailItem = Nothing
End Sub
Public Function AttachmentExist(filepath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
AttachmentExist = fso.FileExists(filepath)
Set fso = nothing
end Function
Public Function SendMail(str_subject,str_body,str_to,str_cc)
objOutlookMsg.To = str_to
objOutlookMsg.CC = str_cc
objOutlookMsg.Subject = str_subject
objOutlookMsg.Body = str_body
Dim str_attachment
'添加附件路径
str_attachment = str_Test_Path&"Report\"&GetTestName&"\Result.xls"
path_attachment = str_Test_Path&"Report\"&GetTestName
If AttachmentExist(str_attachment) Then
'Create FileSystemObject
Set MyFileObject = CreateObject("Scripting.FileSystemObject")
'Create Folder object,get attachment count
Set MyFolder = MyFileObject.GetFolder(path_attachment)
For Each thing in MyFolder.Files
thing = Cstr(thing)
'ADD other Attachments
If ".xls" <> Right(thing,4) Then
objOutlookMsg.Attachments.add(thing)
End If
Next
'ADD xls Attachments
objOutlookMsg.Attachments.add(str_attachment)
End If
'Display the email
objOutlookMsg.Display
' Send the message
objOutlookMsg.Send
end Function
End Class
'Set oMailEngne = new MailEngine
'Call oMailEngne.SendMail("自动化测试结果通知邮件标题","自动化测试结果通知邮件内容","XXX@qq.com","")

复制代码