如果不去挑战,你永远不知道自己的潜能到底有多大!

QTP批量执行并发邮件

上一篇 / 下一篇  2009-12-08 16:29:04 / 个人分类:QTP工具

Option Explicit
'*****************************************************************
'脚本说明:公共变量声明,路径根据实际环境修改
'*****************************************************************
Dim ReportLocation '报告存放路径
ReportLocation = "D:\project\QTP\qtpscript\"
Dim QtpLocation 'Qtp安装路径
QtpLocation = "D:\softwaretesting\Mercury Interactive\QuickTest Professional\bin\QTPro.exe"
'*****************************************************************
'脚本说明:启动QTP
'*****************************************************************
Dim WshShell,oExec
set WshShell = WScript.CreateObject("WScript.Shell")
Set Exec = WshShell.Exec (QtpLocation)
Set WshShell = Nothing
WScript.Sleep 60000 '等待1分钟
'*****************************************************************
'脚本说明:判断文件是否存在,存在删除
'*****************************************************************
Dim oFSO
' 创建一个文件系统对象
set FSO = CreateObject ("Scripting.FileSystemObject")
CheckFileExists(ReportLocation)
Function CheckFileExists (FilePath)
 FilePath = FilePath &"测试结果1.html"
    ' 检查文件是否存在,如果存在删除
    CheckFileExists = oFSO.FileExists(FilePath)
 'MsgBox CheckFileExists
 If (CheckFileExists = true) Then
  oFSO.DeleteFile (FilePath)
 End if
 End Function

'*****************************************************************
'脚本说明:批量执行脚本并生成摘要报告
'*****************************************************************
Dim oMTM
' 创建 Multi Test Manager 对象
Set MTM = CreateObject("MultiTestManager.Application")
oMTM.Visible = True

' 修改运行时的默认设置
Dim oRunSettings
Set RunSettings = oMTM.Preferences.RunSettings
oRunSettings.Iterations = 1
oRunSettings.CloseQuickTest = True
'打开注释启用定时调度
'oRunSettings.ScheduleRun = True
'oRunSettings.Day = 3
'oRunSettings.Month = 12
'oRunSettings.Year = 2009
'oRunSettings.Second = 00
'oRunSettings.Minute = 55
'oRunSettings.Hour = 15


' 修改报告的默认设置
Dim oReportSettings
Set ReportSettings = oMTM.Preferences.ReportSettings
oReportSettings.CreateReport = True
oReportSettings.OverwriteReport = False
oReportSettings.DefaultLocation = False
oReportSettings.ReportLocation = ReportLocation '报告存放路径
oReportSettings.ReportName = "测试结果"
oReportSettings.ViewReport = True


'批量执行脚本:脚本的目录,是否执行,执行结果存放位置
oMTM.AddTestScript. "D:\project\QTP\qtpscript\rarTest", True,ReportLocation
'oMTM.AddTestScript. "D:\project\QTP\qtpscript\rarTest", True,ReportLocation 根据脚本进行添加

' 运行脚本
oMTM.Run
while ( oMTM.IsRunning )
Wend
oMTM.Quit
Set RunSettings = Nothing
Set ReportSettings = Nothing
Set MTM = Nothing

'*****************************************************************
'脚本说明:将运行结果发送邮件
'*****************************************************************
Dim SendTo, Subject, Body, Attachment
'SendTo ="test@163.com;test1@163.com" '发送多个邮箱以分号分割
SendTo ="test@163.com"
Subject ="自动化测试结果"
Body ="自动化测试结果"
Attachment =ReportLocation&"测试结果1.html"
'SendMail SendTo, Subject, Body, Attachment

Function SendMail(SendTo, Subject, Body, Attachment)
 Dim ol,Mail
    Set l=CreateObject("Outlook.Application")
    Set Mail=ol.CreateItem(0)
    Mail.to=SendTo
    Mail.Subject=Subject
    Mail.Body=Body
    If (Attachment <> "") Then
        Mail.Attachments.Add(Attachment)
    End If
   ' Mail.display '邮件显示
    Mail.Send
    ol.Quit
    Set Mail = Nothing
    Set l = Nothing
End Function


TAG:

huamini ---热衷于测试管理领域! 引用 删除 huamini   /   2012-04-12 11:53:53
你好,能不能发多个附件,如何实现呢?tks
 

评分:0

我来说两句

Open Toolbar