qtp 抓屏并保存

' captureScreen: capture the screen image and save it as .png
'Imagepath: the image path, such fxpg ,  "D:\ERM\Report\FXBS\FXPG"
'imageSaveName: the image Name

Function captureScreen(Imagepath, imageSaveName)
    Dim reportDay
    Dim imageFormat

    Set ifso = CreateObject("Scripting.FileSystemObject")
    reportDay = cstr(Date)
    imageFormat = ".png"
    imgFolderPath = Imagepath+backslant + reportDay
    
    If ifso.FolderExists(imgFolderPath) Then
        else
        ifso.CreateFolder(imgFolderPath)
    End If

    If ifso.FileExists(imgFolderPath +backslant+ imageSaveName +imageFormat) Then
        imageCout = imageCout +1
        If imageCout = 2 Then
            imageSaveName = imageSaveName + cstr(imageCout)
        End If       

        If imageCout>2 and imageCout =< 10 Then
            imageSaveName = left(imageSaveName, len(imageSaveName)-1) + cstr(imageCout)
        End If

        If imageCout>=10 and imageCout < 100Then
            imageSaveName = left(imageSaveName, len(imageSaveName)-2) + cstr(imageCout)
        End If     
        Set ifso = nothing
       
        captureScreen Imagepath, imageSaveName
       
    else
        desktop.CaptureBitmap imgFolderPath +backslant+ imageSaveName+imageFormat,Ture       
    End If
    Set ifso = nothing
End Function