51Testing软件测试论坛

 找回密码
 (注-册)加入51Testing

QQ登录

只需一步,快速开始

微信登录,快人一步

手机号码,快捷登录

查看: 1122|回复: 1
打印 上一主题 下一主题

[原创] 【seagull1985-QTP】测试过程屏幕截图保存

[复制链接]
  • TA的每日心情
    奋斗
    2018-8-27 15:56
  • 签到天数: 322 天

    连续签到: 1 天

    [LV.8]测试军长

    跳转到指定楼层
    1#
    发表于 2016-4-18 18:03:49 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
    1. '==========================================================================
    2. ' NAME: User Login
    3. ' AUTHOR: heyl  
    4. ' DATE  : 2012-12-21
    5. ' COMMENT:  
    6. '==========================================================================
    7. Class ScreenCaptureEngine

    8.              Public str_ScriptPath
    9.                          Public  oFSO
    10.                        
    11.                          Private Sub Class_Initialize   
    12.                                   str_ScriptPath = str_Test_Path&"Report\"
    13.                                   str_ScriptPath = str_ScriptPath&GetTestName
    14.                                   me.Createreporterfolder(str_ScriptPath)
    15.              End Sub
    16.                        
    17.                         Private Sub Class_Terminate      
    18.                         Set oFSO = nothing
    19.                         End Sub
    20.             
    21.                         'create a folder
    22.                         Function Createreporterfolder(str_folderpath)
    23.                         Dim fso, f
    24.                         Set fso = CreateObject("Scripting.FileSystemObject")
    25.                            If Not fso.FolderExists(str_folderpath)  Then
    26.                            Set f = fso.CreateFolder(str_folderpath)
    27.                            Set f = Nothing
    28.                            Set fso = Nothing
    29.                            Else
    30.                            Set fso = Nothing
    31.                            End If
    32.                         End Function

    33.                         Public Sub Report()
    34.                          
    35.                            Dim sFile
    36.                            Dim sTimeStamp
    37.                
    38.                        
    39.                        
    40.                            Set oFSO = createobject("Scripting.FileSystemObject")
    41.                            sTimeStamp = CStr(Now)
    42.                            sTimeStamp = Replace(sTimeStamp , "\", "")
    43.                            sTimeStamp = Replace(sTimeStamp , "/", "")
    44.                            sTimeStamp = Replace(sTimeStamp , ":", "")
    45.                        
    46.                            sFile = str_ScriptPath
    47.                            If Mid(sFile, Len(sFile),1) <> "\" Then sFile = sFile & "\"
    48.                           
    49.                            sFile = sFile & " " & sTimeStamp & ".png"
    50.                        
    51.                            While oFSO.FileExists(sFile)
    52.                                    sFile = Mid(sFile ,1,Len(sFile)-4) & "_1" & ".png"
    53.                            Wend
    54.                           
    55.                            Desktop.CaptureBitmap(sFile)
    56.                          
    57.                         End Sub
    58. End Class

    59. Set oScreenCapture = new ScreenCaptureEngine
    复制代码


    评分

    参与人数 1测试积点 +10 收起 理由
    lsekfe + 10 支持分享~

    查看全部评分

    分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
    收藏收藏
    回复

    使用道具 举报

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    小黑屋|手机版|Archiver|51Testing软件测试网 ( 沪ICP备05003035号 关于我们

    GMT+8, 2024-11-23 08:06 , Processed in 0.067646 second(s), 23 queries .

    Powered by Discuz! X3.2

    © 2001-2024 Comsenz Inc.

    快速回复 返回顶部 返回列表