最新可用的源码更新如下(主要修改了对应的EXCEL的操作,修改为了单例模式进行操作EXCEL对象,使得操作excel更加的快速,而且有效);
源码如下:(本框架本博客版权所有,未经本人许可不得用于其他商业用途,转载请注明出处.谢谢)
'*******************************************************************************************'功能:新建一个excel文件'参数：无'返回值：创建一个excelapp的进程'作者：judd'*******************************************************************************************Function'As Excel.ApplicationDim'As Excel.worksheetSet"Excel.Application"'Create a new excel Object' ExcelApp.Workbooks.AddfalsefalseSetEndFunction'*******************************************************************************************'功能：得到对应的指定文件的sheet实例对象'参数：打开对应的一个excelapp进程对应的sheet名称'返回值：excelapp的一个sheet对象'作者：judd'*******************************************************************************************Function'As Excel.worksheetOnErrorResumeNext'获取需要写入的文件的路径FalseSetOnErrorGoToEndFunction'*******************************************************************************************'功能:对excel中写入值'参数：对应的excelapp的一个sheet的实例对象xlswork，sheet对象，x，行数，y，列数，values，对应的写入的值'返回值：无'作者：judd'*******************************************************************************************FunctionOnerrorresumenext' xlswork.Worksheets(sheetindex).ActivateOnErrorGoToEndFunction'*******************************************************************************************'功能：获取excel中指定的单元格中的数据'参数：testpath表示需要写入数据的excel的路径，sheetname表示需要写入的excel的sheet名称，x代表excel代表单元格中的行，y代表单元格中的列'返回值：获取你所需指定的单元格的值'作者：judd'*******************************************************************************************FunctionOnErrorResumeNextIfThenEndIfOnErrorGoTo' MsgBox "successbox"EndFunction'*******************************************************************************************'功能：删除对应的excel中的指定的行'参数：xlswork指定的sheet对象，rownum指定的行数'返回值：null'作者：judd'*******************************************************************************************FunctionEndFunction'openAndWriteExcel "d:\maybe.xlsx",1,1,"abcziptestdddddddddddddddd"'*******************************************************************************************'功能:关闭excelapp进程'参数：excelapp对应的是excel的进程对象'返回值：无'作者：judd'*******************************************************************************************SubSetSetSet"Scripting.FileSystemObject"OnErrorResumeNext"C:\Temp""C:\Temp\ExcelExamples.xls""C:\Temp\ExcelExamples.xls"SetNothingSetNothingOnErrorGoToEndSub'*******************************************************************************************'功能:保存已经实现的excel进程实例的sheet对象'参数：excelApp表示对应的excel进程对象，workbookIdentifier 表示sheet的id，path表示临时保存的excel的路径，可不写为空字符'返回值：无'作者：judd'*******************************************************************************************Function'As StringDim'As Excel.workbookOnErrorResumeNextSetOnErrorGoToIfNotIsNothingThenIf""OrOrThenElseSet"Scripting.FileSystemObject"'if the path has no file extension then add the 'xls' extensionIf"."Then".xls"EndIfOnErrorResumeNextSetNothingOnErrorGoToEndIf"OK"Else"Bad Workbook Identifier"EndIfEndFunction'*******************************************************************************************'功能:比较两个excel的sheet的内容是否一致'参数：sheet1,第一个sheet的实例sheet2第二个sheet的实例对象 startColumn第几列 numberOfColumns共计多少列 startRow, 第几行numberOfRows,共计有多少行trimed是否忽略空格'返回值：无'作者：judd'*******************************************************************************************Function'As BooleanDim'As BooleanDim"共计有多少数据"true'In case that one of the sheets doesn't exists, don't continue the processIfIsNothingOrIsNothingThenfalse'reportResult(teststep, expectvalue, actualvalue)"比较对应的测试结果的两个sheet内容""两个sheet内容存在""两个sheet的内容为空，请确认sheet后再操作"ExitFunctionEndIf'loop through the table and fill values into the two worksheetsFortoForto'if 'trimed' equels True then used would like to ignore blank spacesIfThenEndIf"value expect:""value acutal:"'in case that the values of a cell are not equel in the two worksheets'create an indicator that the values are not equel and set return value'to FalseIfThenDim'As Excel.Range' print "运行的[实际结果为:]" & Value2 & "'[,预期结果为:]" & Value1 "Failed:比较sheet对应的单元格值""此处结果为:[""],实际结果为:[""]"Set' print "当前运行"&r&"第列"&cFalseelse"PASS:比较sheet对应的单元格值"EndIfNextNextEndFunction''MsgBox(getCellDatas("d:\maybe.xlsx",1,1))'*******************************************************************************************'功能：获取excel文件的路径'参数：path代表excel文件名'返回值：获取excel文件的绝对路径'作者：'*******************************************************************************************'Function findPath(path)' findPath=pathfinder.Locate(path)'End Function'字符串截取特殊字符重新生成所需新的字符串'*******************************************************************************************'功能：时间字符串格式转换'参数：str代表时间字符串，formatdata代表需要截取的字符'返回值：获取你所需指定的单元格的值'作者：judd'*******************************************************************************************Function""Endfunction'时间格式化操作函数'*******************************************************************************************'功能：将vb的时间设置成固定的格式后'参数：str代表时间字符串，formatdata代表需要截取的方式，'返回值：获取你所需指定的单元格的值'作者：judd'*******************************************************************************************FunctionselectcaseRem 时间格式为：YYYYMMDDHHmmss case"1""00""00""00""00""00"Rem 时间格式为：YYYYMMDD case"2""00""00"Rem 时间格式为：YYYY-MM-DD case"3""-""00""-""00"Rem 时间格式为：YYYY年MM月DD日 case"4""年 ""00""月 ""00""日"Rem 时间格式为：HH:mm:ss case"5""00"":""00"":""00"endselect' If error.number>0 Then'reportResult(teststep, expectvalue, actualvalue)' reportResult "时间日期转换函数","转换成功","转换成功"'End IfendFunction'*******************************************************************************************'功能：发送邮件通知执行步骤'参数：sentto表示需要发送的人，subject邮件的主题，body邮件需要发送的内容，attachment表示邮件的附件的路径'返回值：无'作者：'*******************************************************************************************FunctionSet"Outlook.Application"SettoIf""ThenEndIfSetNothingSetNothingEndFunction'*******************************************************************************************'功能：打印QTP的报告'参数：teststep表示在QTP的报告中报告的步骤，expectvalue表示预期的测试执行结果，actualvalue表示实际的测试执行结果'返回值;'作者：'*******************************************************************************************FunctionOnerrorresumenext'expectvalue="exp_"&actualvalue"5""RunImgs"'listpath=resultpath&"\"&teststep&"---"×tamp&".png""\""截图--"".png"'打印当前运行的状态。。'Reporter.ReportEvent micDone,"当前测试内容【"&teststep&"】,列表如下:","测试执行开始!!!",imgpathIfThen'desktop.CaptureBitmap imgpath"当前的测试步骤为-【""】-执行成功！""当前的测试用例结果:"",预期的测试结果为【""】,实际的测试结果为【""】,与预期结果相同""测试执行通过---PASS"else' desktop.CaptureBitmap imgpath"当前的测试步骤为-【""】-执行失败！""当前的测试用例结果:"",预期的测试结果为【""】,实际的测试结果为【""】,与结果不相同""测试执行失败---FAILED"' SendMail "charilyhu@gmail.com","测试执行步骤","执行步骤"&teststep,""EndIfEndFunction'*******************************************************************************************'功能:在指定的已有的excel中插入一个sheet，最大支持45列（注意）'参数：filename表示excel的名称，oldsheetname表示需要excel文件中的第一个sheet的名称,templatefilename表示需要导入excel中的sheet的模板excel文件名称，支持模糊匹配'templatefsheetname表示导入excel中的sheet的模板excel文件的sheet名称'返回值：'*******************************************************************************************FunctionOnerrorresumenextDim'As Excel.workbookDim'As Excel.worksheet'如果指定的工作薄不存在，将在当前激活状态的工作表中添加工作表'print excelpathSet"excel.application"SetSet'获取工作薄中工作表的数量Set'得到第一个sheet名称' Debug.Write tname.nameIfThenSet'添加工作表' Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet为新添加的工作表对象 ' = '初始化worksheet为新添加的工作表对象'设置新添加的工作表名称' rownum=getRowRange(temppath,templatesheetindex) 'excel中的可用的行数,此处的调用会弹出excel对象重用的问题，所有不考虑使用这种方式Set"A1:AT"'得到可用区域的所有的表格的内容数组FortoFortoNextNextIf""ThenEndIfElse"文件sheet名称不存在，出现错误"Endif' ExcelApp.cfalseSetNothingEndFunction'*******************************************************************************************''功能：通过QTP的自身的环境变量进行确认相关的需要的路径'参数：需要查询的文件的路径的文件名称,pathtype表示查询路径的类型，可选的是0,1,2,3,4'返回值：返回查询文件的绝对路径'*******************************************************************************************FunctionOnerrorresumenextSet"scripting.filesystemobject""RunLogs"IfThen"TestPath"elseifthen"InputData"elseifthen"OutputData"elseifthen"RunImgs"elseifthen"RunLogs"else"TestPath"EndIf'引入的下面的文件的遍历操作set"\FilePaths.txt"'读取临时的log文件中的第一行的路径名称SetnothingSetnothingEndFunction'*******************************************************************************************''功能：遍历环境变量中预设的数据值路径，然后过滤找到指定的文件名，并存放在text文件中'参数：datapath表示查找文件的路径，filename表示需要查找的文件名称'返回值：无'*******************************************************************************************FunctionOnerrorresumenextSet"scripting.filesystemobject"IfThenSetForeachin"\"NextForeachin' print trim(testfile.name)' print instr(1,trim(testfile.name),bfile,1)IfThen"RunLogs"'If not fso.FileExists(logpath&"\FilePaths.txt") Thenset"\FilePaths.txt"trueSetnothing' Set firstsub=nothingSetnothingExitfunctionelse'ReportProgress(Text, Title, TimeOut)'ReportProgress "在指定的路径下没有找到你需要的文件"' logfile.WriteLine testfile.path' logfile.Close' Set logfile=nothing' Set firstsub=nothing' Set fso=nothing' print "没有找到对象啊"EndIfNextelse'ReportProgress(Text, Title, TimeOut)"enviroment文件中的测试路径找不到，请确认你的environment文件正确配置或者加载到QTP中，使用loadQTPXML方法进行加载XML文件到QTP中！"' logfile.WriteLine testfile.pathSetnothing' Set firstsub=nothingSetnothingEndIfEndFunction'Function: LoadDictionary'Website: http://KnowledgeInbox.com'Author: Tarun Lalwani'Description: Load Dictionary object from a XML file'Parameters:'@oDic: The Dictionary object in which the values need to be loaded'@FileName: The XMLfile path from where the dictionary needs to be loaded'Return value:'The oDic dictionary objectFunction'Exit if the file doesn't existIfNot"Scripting.FileSystemObject"ThenExitFunctionDim'Load the XMLfileSetSet'Load all XML variablesSet"//Variable"Dim'Enumerate and populate each dictionary keyFortoSet"Name""Value"NextEndFunction'Function: LoadDictionary'Website: http://KnowledgeInbox.com'Author: Tarun Lalwani'Description: Save dictionary object to a XML file'Parameters:'@oDic: The Dictionary object for which the values need to be exported as XML'@FileName: The XMLfile path where the dictionary needs to be saved'Return value:'The oDic dictionary object'''''FunctionDimSet"WScript.Shell""HKCU/Software/Mercury Interactive/QuickTest Professional/MicTest/ReservedObjects/GlobalDictionary/ProgID""Scripting.Dictionary""REG_SZ"SetNothing"name"' saveDIC=mydic.Item("name")EndFunction'*******************************************************************************************'功能：在excel中查找一个特定的字符'参数：testpath表示excel路径，x,y代表查找的单元格的行和列，newvalues是查找的字符'返回值：查找到的sheet的名称'作者：judd'*******************************************************************************************FunctionOnerrorresumenextSet"excel.application"setSetFortoifthen'reportResult(teststep, expectvalue, actualvalue)"在excel中查找字符""查找到期望字符""查找到期望字符"Exitforelse"0""在excel中查找字符""能查找到期望字符""没有查找到期望的字符"endifNextSetnothingEndFunction'*******************************************************************************************'功能：测试用，观察当前运行的测试执行情况'参数：text表示运行的弹出的提醒的文本，timeout表示等待的时候，如果在等待的时候内，对弹出窗口没有响应，则会自动关闭'返回值:无'作者：'*******************************************************************************************PublicSubSet"WScript.Shell""测试执行过程观察器"EndSub'*******************************************************************************************'功能：导入运行中的excel数据到datatable中'参数：filename表示指定的需要导入当前的action的名称，支持模糊输入，sheetindex表示excel的sheet的索引，srcsheetname表示需要导入的datatable对象中的sheet名称'返回值:无'作者：judd'*******************************************************************************************Function'findPathByEnv(filename, pathtype)EndFunction'*******************************************************************************************'功能：获得excel的可用区域行数'参数：filename表示excel文件的名称，支持模糊输入，sheetindex表示excel的sheet的索引数'返回值:excel中可用的行数（带有数据的）'作者：judd'*******************************************************************************************FunctionOnerrorresumenextEndFunction'*******************************************************************************************'功能：清空指定的sheet的第二行起的所有内容'参数：filename表示需要清空的excel文件名称，支持模糊文件名称，sheetindex表示需要清空的excel的sheet的索引'返回值：无'作者：'*******************************************************************************************FunctionOnerrorresumenext'获取指定文件的完整路径Set"Excel.Application"false'将excel对象隐藏不要显示打开SetSet'获得sheet对象'获得excel中的有数据的行数'xlssheets.usedrange.clear 全部删除内容' xlssheets.Rows(rowt).Delete"A1:AI"falseSetNothingEndFunction'*******************************************************************************************'功能：运行进程中是否存在某进程,如果有返回true,没有返回false'参数：processname:进程名'返回值：true:有该进程，false:没有该进程'作者：judd'*******************************************************************************************Functiononerrorresumenextset"winmgmts:\\.\root\cimv2"'wmi调用的方式set"wscript.shell"set"select * from win32_process"'查询数据表foreachin'ReportProgress(Text, Title, TimeOut)'print i.nameIfThen' ReportProgress i.name&"进程存在，测试需要关闭该进程，请尽快保存该进程对应的文件，系统将在10秒内强制关闭该进程",10trueExitfunctionelsefalseEndIfnext"判断是否存在""进程""该进程不存在"'existProcess=falseEndFunction'*******************************************************************************************'功能：获得当前脚本运行机器的IP地址'参数：无'返回值：运行脚本的机器的IP地址'作者：judd'*******************************************************************************************FunctionSet"WScript.Shell"Set"ipconfig.exe"Set""DoUntilIf"本地连接"Then":"""ExitDoEndIfLoopIf""Then"获取执行机器IP地址""获取IP地址失败"ElseEndIfEndFunction'*******************************************************************************************'功能：加载XML文件'参数：ip表示共享存放文件的机器IP地址，xmlfilename表示加载的xml文件名称'返回值：无'作者：judd'*******************************************************************************************Function"\\""\ScriptDatas\XML\"'envs=environment.Value("TestPath")'reportResult(teststep, expectvalue, actualvalue)' reportResult "加载xml到环境中","加载成功","xml已经加载在环境中了"EndFunction'*******************************************************************************************'功能:获得web对象中的table对象的表头列所对应的列号'参数：obj参数表示table对象，textid表示table的标头列所在的行数，indextext表示标头列的文本，支持模糊匹配'返回值：所在的列数'作者：judd'*******************************************************************************************FunctionSetForto'print "ttt:"&Table.GetCellData(textid,i)IfthenExitforelseendifnextSetnothingEndFunction'*******************************************************************************************'功能:获得web对象中的table对象的表头列所对应的文本数组'参数：obj参数表示table对象，textid表示table的标头列所在的行数，indextext表示标头列的文本，支持模糊匹配'返回值：所有的列头的文本数组对象'作者：judd'*******************************************************************************************FunctionOnerrorresumenextSetSet"scripting.dictionary"FortonextSetnothingSetnothingEndFunction'*******************************************************************************************'功能:生成不同的action之间传值的一个全局对象'参数：无'返回值：无'作者：judd'使用实例：直接在QTP中使用DataDic即可使用该字典对象'*******************************************************************************************FunctionOnerrorresumenextSet"wscript.shell""HKCU\Software\Mercury Interactive\QuickTest Professional\MicTest\ReservedObjects\DataDic\ProgID""Scripting.Dictionary""REG_SZ"SetNothingEndFunction'*******************************************************************************************'功能：将打印日志在text文件中'参数：teststep表示需要打印的日志内容'返回值：无'*******************************************************************************************FunctionConstDimSet"Scripting.FileSystemObject""RunLogs""\""_"".txt"SetTruecstr" 当前测试步骤为:"EndFunction'*******************************************************************************************'功能：将打印日志在text文件中'参数：teststep表示需要打印的日志内容'返回值：无'*******************************************************************************************FunctionConstDimSet"Scripting.FileSystemObject""RunLogs""\"".txt"SetTruecstr" 当前测试步骤为:""'*******************************************************************************************'***********************************************************************************""'*******************************************************************************************'***********************************************************************************"EndFunction'*******************************************************************************************'功能：随机函数生成'输入值：生成值范围 i～j'返回值：随机数'*******************************************************************************************PublicFunctionIfOrThen"只接受大于零的输入"ElseIfthen"起始值必须小于结束值"ElseDimDimForToNextEndIfEndFunction'*******************************************************************************************'功能：随机生成一定长度的字符串'输入值：需要生成的字符串的长度'返回值：字符串'作者：judd'*******************************************************************************************FunctionDimIfThenForTo"0""1""2""3""4""5""6""7""8""9""a""b""c""d""e""f""g""h""i""j""k""l""m""n""o""p""q""r""s""t""u""v""w""x""y""z"Nextelse"只接受数字输入"EndIfEndFunction'*******************************************************************************************'功能：加载页面，等待页面显示'输入值：frameobj表示iframe对象，'返回值：无'作者：judd'*******************************************************************************************FunctionSetWhilenotWendEndFunction'*******************************************************************************************'功能：导航页面到指定的页面中'输入值：url表示需要导航的页面的地址'返回值：无'作者：judd'*******************************************************************************************Function'existProcess(processname)"iexplore.exe"'关闭IE进程IfTrueThen"iexplore.exe"If"Long"Then'reportResult(teststep, expectvalue, actualvalue)"关闭IE进程中""关闭成功""关闭成功"else'reportResult(teststep, expectvalue, actualvalue)"关闭IE进程中""关闭成功""关闭失败"EndIfEndIf"iexplore.exe"""""EndFunction'*******************************************************************************************' 函 数名: CloseBrowsers' 功能说明: 关闭所有IE浏览器' 参 数 1: 无' 返 回值: 无' 附加说明: 无' 举例说明: CloseBrowsers()'*******************************************************************************************PublicFunctionOnErrorResumeNextIf"micclass:=Browser"Then"micclass:=Browser"EndIfWhile"micclass:=Browser""index:=1""index:=1"WendIf"micclass:=Browser"Then'再次关闭IE，防止前面过程还有IE没有关闭掉"micclass:=Browser"EndIftrueEndFunction'*******************************************************************************************'功能：值交换函数'参数：a第一个数，b第二个数'返回值：无'作者：'*******************************************************************************************PublicSubbyrefbyrefDimEndSub'*******************************************************************************************'功能：去掉字符串中的重复项'参数：inp字符串，sp重复的字符'返回值：无重复的字符串'作者：judd'*******************************************************************************************FunctionDimDoFalseForToForToIfThenTrue""ForToNextForToNextEndIfNextIfTrueThenExitForEndifNextLoopUntilfalseEndFunction
'*******************************************************************************************
本文转自hcy's workbench博客园博客，原文链接：http://www.cnblogs.com/alterhu/archive/2012/06/15/2551076.html，如需转载请自行联系原作者。
