Monday, May 2, 2011

Verify Coloum exist in Datatable


 'Arguments Passed          : 1. objSheet -  Datatable object
'                                        2. strColumnName - Parameter name
'Return Value                    : True or False   

Function Fn_VerifyDataTableColumnExists(byRef objSheet, byval strColumnName)
    
     Dim intParamTotal
     Dim intIterator
     Dim intValue
    
     ' get total nbr of columns in datatable
     intParamTotal = objSheet.GetParameterCount
    
     ' loop all columns
     For intIterator = 1 To intParamTotal
    
          'get name of column
          intValue = objSheet.GetParameter(intIterator).Name
          
          ' compare if column name matches
          If strComp(strColumnName,intValue)=0 Then
           Fn_VerifyDataTableColumnExists=TRUE
           Exit Function
          End if
     Next
     Fn_VerifyDataTableColumnExists = False
    
End Function

Monday, April 11, 2011

Function to verify whether any excel instance is open or not. If opened terminate the same.

Function IsAnyExcelInstancesOpen 'As Boolean

    IsAnyExcelInstancesOpen = True

    Dim objWMIService, objProcess, ProcessCollection
    Dim strComputer, strMessage
    Dim bolTerminate
    Dim InputUserSelection
    ' Make it true if you want to terminate process without any user;s permission.
    bolTerminate = False
   
    strComputer = "."
   
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   
    Set ProcessCollection = objWMIService.ExecQuery("Select * from Win32_Process")
   
    For Each objProcess in ProcessCollection
    If StrComp(objProcess.Name, "Excel.exe", 1) = 0 Then
        ' If true it will terminate process without any message or intimation
        If boolTerminate Then
            objProcess.Terminate()
        ' It will ask user(Permission) input "Yes" to terminate excel instance opened.     
        Else
           
            strMessage = "An Instance of Excel is running on the Machine. The Framework needs all the Excel instances to be closed for running the Tests." & vbCr & vbCr &_
                "Do you want the Framework to CLOSE all the instances of the Excel?" & vbCr & vbCr &_
                " - Yes:" & vbCr & "Click on Yes to close all the instances of Excel and proceed with the Test Execution." & vbCr & vbCr &_
                " - No :" & vbCr & "Click on No to Stop the test execution and close the Excel files manualy." & vbCr & "--" & vbCr &_
                "Note: All unsaved data in the open excel files will be lost on clicking Yes."
               
            oUserSelection = MsgBox(strMessage, vbYesNo + vbExclamation , "Excel Instances Open")
               
            If oUserSelection = vbYes Then
               
                boolTerminate = True
                objProcess.Terminate()
               
            Else
           
                Exit Function
               
            End If
           
        End If
       
    End If
   
    Next

    IsAnyExcelInstancesOpen = False
   
End Function

To get list of specific file from specific folder

'Funtion to get list of the specific type of files(Based on extension) in specified folder. In this example will filter 'out file having "txt", "qfl" & "vbs" extension. To get the list of file you have keept Array global for atleast that 'file (depend on implementation).
Public Function GetFileList (folderLocation, RequiredfileNames()) 'As Boolean
   
    'Initialize the function and declare the variables
    GetFileList = False
    Dim fso, sfileName, files, fileCount, folder, selectedFile
    fileCount = 0
     On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")     
    Set folder = fso.GetFolder(folderLocation) 
    Set files = folder.Files
   
    'Browse through all the files in the selected folder
    For each selectedFile In files
           sfileName = selectedFile.Name
          
           'Filter the file based on the extension of the file
        If (StrComp(Right(sfileName,3), "txt", 1) Or StrComp(Right(sfileName,3), "qfl", 1) Or StrComp(Right(sfileName,3), "vbs", 1)) Then
            ReDim Preserve RequiredfileNames(fileCount)
            RequiredfileNames(fileCount) = sfileName
            fileCount = fileCount + 1                                      
        End If
    Next 
   
    'Finalize the function and return the value
    If(fileCount > 0) Then
        GetFileList = True
    End If
   
End Function

Monday, February 21, 2011

Read a Bookmark in a Word Document

Set objWord = CreateObject("Word.Application")
objword.Visible = False
Set objDoc = objWord.Documents.Open("e:\copy.doc")

Do until objDoc.AtEndofStream
                                stxt = objDoc.Readline
                                MsgBox stxt
Loop

objdoc.Close
objWord.Quit

Get Detail of Object Drive


Dim filesys
set filesys = CreateObject("Scripting.FileSystemObject")
Set drv = filesys.GetDrive("e")

select case drv.DriveType
                Case 0: drtype = "Unknown"
                Case 1: drtype = "Removable"
                Case 2: drtype = "Fixed"
                Case 3: drtype = "Network"
                Case 4: drtype = "CD-ROM"
                Case 5: drtype = "RAM Disk"
End Select

WScript.Echo "The specified drive is a " & drtype & " type disk."
WScript.Echo " "
WScript.Echo "Total size is " & drv.TotalSize & ". "
WScript.Echo "Available space is " & drv.AvailableSpace &  ". "
WScript.Echo "Type is " & drv.DriveType &  " "
WScript.Echo "Path is "  & drv.Path &  " "

Dim filesyst, drive
Set filesyst = CreateObject("Scripting.FileSystemObject")
WScript.Echo "Before Condtion"

drive =  filesyst.DriveExists("z")
WScript.Echo drive

                If filesyst.DriveExists("z") Then
                                WScript.Echo("The specified drive does exist.")
                Else
                                WScript.Echo("The specified drive does not exist.")
                End If
WScript.Echo "After Condtion"

Sort Excel Worksheet

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)

objExcel.Cells(1, 1).Value = "4"
objExcel.Cells(2, 1).Value = "1"
objExcel.Cells(3, 1).Value = "2"
objExcel.Cells(4, 1).Value = "3"
objExcel.Cells(1, 2).Value = "A"
objExcel.Cells(2, 2).Value = "B"
objExcel.Cells(3, 2).Value = "C"
objExcel.Cells(4, 2).Value = "D"

Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("A1")
objRange.Sort(objRange2)

Tuesday, February 15, 2011

Copy Specifc Data from One Excel to Other

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Excel application not found."
    Wscript.Quit
End If
On Error GoTo 0

'Create an object for Excel file

Set xlBook = objExcel.Workbooks.Open("C:\Documents and Settings\deepakpe\Desktop\Mine_doc\new.xlsx")
Set xlSheet = xlBook.Worksheets(1)


' Select the range of data to be copy
objexcel.Range("D1:D46").Copy
set xlSheet = xlBook.Worksheets("Sheet2")
' Select the range where we want to copy
objexcel.Range("C3").Select
objexcel.Range("c3").Copy


objExcel.ActiveWorkbook.Close
objExcel.Application.Quit

'Release an object

Set xlBook = Nothing
Set xlSheet = Nothing
 
Design by Free WordPress Themes | Bloggerized by Lasantha - Premium Blogger Themes | JCpenney Printable Coupons