Wednesday, 14 October 2015

#17. Excel Functions using QTP

Readdata, WriteData, GetRowCount and GetColumntCount

Set xlApp= CreateObject("Excel.Application")
xlApp.Visible=true
xlApp.DisplayAlerts=false
Set sheet= nothing
Set myXLS= nothing

Function BrowserMaximize(Object)
   Dim hwnd
   hwnd = Object.GetROProperty("hwnd")
   On error resume next
   Window("hwnd:="&hwnd).activate
   If err.Number<>0 Then
       hwnd = Browser("hwnd:="&hwnd).Object.hwnd
       Window("hwnd:="&hwnd).activate
       err.clear
   End If
   Window("hwnd:="&hwnd).Maximize
   On error Goto 0
End Function

'  saves the xl file and destroys all objectects related to it
Function destroyFile
   ' destroys sheet
    If NOT sheet is nothing Then
        Set sheet=nothing
    End If
    ' destroy xl file
    If NOT  myXLS is nothing Then
        myXLS.save
        myxls.close
        Set myxls=nothing
    End If
End Function

Function destroyXLSApp
    destroyFile
    If  NOT xlApp is nothing Then
        xlApp.Application.Quit
        Set xlApp=nothing
    End If
End Function

' checks if a file exists
Function isFileExisiting(filePath)
   Set fso = createObject("Scripting.FileSystemObject")
   If  fso.FileExists(filePath)  Then
    isFileExisiting=true
   else
    isFileExisiting=false
   End If
End Function

'  Checks if sheet is existing
Function isSheetExisting(filePath,sName)
   Dim totalsheets,sNum
    totalsheets = myXLS.Worksheets.count
    For sNum=1 to totalsheets
        If  myXLS.Worksheets(sNum).name = sName Then
            isSheetExisting=true
            Exit Function
        End If
    Next
isSheetExisting=false
End Function

' write data in xls file
Function writeData(xlFilePath,sName,row,col,data)
    If  xlPath <> xlFilePath Then
        ' destroy previous xls opened - if
            destroyFile
        '  check if the file is existing
            If NOT isFileExisiting(xlFilePath) Then
                msgbox "File not found " & xlFilePath
                exitTest
            End If
        ' open the xl file
        Set myXls = xlApp.Workbooks.Open(xlFilePath)
        xlPath=xlFilePath
        ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
        ' open the sheet of xl file
        Set sheet=myXls.Worksheets(sName)
        sheetName=sName
    '  file is same but sheet is diff
    ElseIf sheetName <>  sName Then
       ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
        'destroys sheet
        If NOT sheet is nothing Then
            Set sheet=nothing
        End If
        ' open the sheet of xl file
        Set sheet=myXls.Worksheets(sName)
        sheetName=sName
    End If
' write data
sheet.Cells(row, col).Value =data
myXLS.save
End Function


'  Reads the data from XLS File
Function readData(xlFilePath,sName,row,col)
    If  xlPath <> xlFilePath Then
        ' destroy previous xls opened - if
            destroyFile
        '  check if the file is existing
            If NOT isFileExisiting(xlFilePath) Then
                msgbox "File not found " & xlFilePath
                exitTest
            End If
        ' open the xl file
        Set myXls = xlApp.Workbooks.Open(xlFilePath)
        xlPath=xlFilePath
        ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
        ' open the sheet of xl file
        Set sheet=myXls.sheets(sName)
        sheetName=sName
    '  file is same but sheet is diff
    ElseIf sheetName <>  sName Then
       ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
           ' destroys sheet
        If NOT sheet is nothing Then
            Set sheet=nothing
        End If
        ' open the sheet of xl file
        Set sheet=myXls.sheets(sName)
        sheetName=sName
    End If
' read the data from the sheet
  readData = sheet.cells(row,col)
End Function

'returns total cols in xls file
Function getColumnCount(xlFilePath,sheetName)
    Dim totalCols
    totalCols=0
    While readData(xlFilePath,sheetName,1,(totalCols+1)) <> ""
        totalCols=totalCols+1
    Wend
    getColumnCount=totalCols
End Function

Function getRowCount(xlFilePath,sName)
   Dim i, j, flag, r, c
   If  xlPath <> xlFilePath Then
        ' destroy previous xls opened - if
            destroyFile
        '  check if the file is existing
            If NOT isFileExisiting(xlFilePath) Then
                msgbox "File not found " & xlFilePath
                exitTest
            End If
        ' open the xl file
        Set myXls = xlApp.Workbooks.Open(xlFilePath)
        xlPath=xlFilePath
  
        ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
        ' open the sheet of xl file
        Set sheet=myXls.sheets(sName)
        sheetName=sName
    '  file is same but sheet is diff
    ElseIf sheetName <>  sName Then
       ' check if sheet is present
        If NOT isSheetExisting(xlFilePath,sName) Then
                msgbox  xlFilePath & " has not got sheet -  " & sName
                exitTest
        End If
           ' destroys sheet
        If NOT sheet is nothing Then
            Set sheet=nothing
        End If
        ' open the sheet of xl file
        Set sheet=myXls.sheets(sName)
        sheetName=sName
    End If
    r = sheet.usedrange.rows.count
    c = sheet.usedrange.columns.count
    flag = 0
    For i = r to 1 step -1
        For j = c to 1 step -1
            If sheet.Cells(i, j)<>"" Then
                flag = 1
                Exit For
            End If
        Next
        If flag = 1 Then      
            Exit For
        End If
    Next
    r = i
    getRowCount = r
End Function


No comments:

Post a Comment