Below I put one Visual Basic script code. It reads the given excel file and put the details of each cell into a log file. Copy all contents from below textbox and save it as MyExcel.vbs and try to run this VBS file. You can run this script by using any GUI Testing tool. Command line call should be cscript MyExcel.vbs sExcelFile iStartRow iStartCol iEndRow iEndCol iSheetIndex
To Know more about this VBA Help, download help from this link Microsoft Office 2003 Editions: Excel VBA Language Reference
If you are unable to run any VBScript, See my earlier post Unable to run VBS or CScript in Windows XP .
VB Script to Read Excel Contents
' USAGE: MyExcel.vbs "D:\VB\Complex.xls" iStartRow iStartCol iEndRow iEndCol iSheetIndex
'cscript MyExcel.vbs "D:\VB\Complex.xls" 1 1 30 12 2
'******** Variables Declaration
' Files section
'XLS File name
gsFile="D:\VB\Complex.xls" 'File with macros
gsLogFile="D:\VB\Results_vbs.log"
Dim gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
Dim gsResultsFile 'Text file name
gsDirSeparator = "\" 'Directory separator character
If WScript.Arguments.Count = 6 Then
gsExcelFile = WScript.Arguments.Item(0)
giStartRow = CInt (WScript.Arguments.Item(1))
giStartCol = CInt (WScript.Arguments.Item(2))
giEndRow = CInt (WScript.Arguments.Item (3))
giEndCol = CInt (WScript.Arguments.Item (4))
giSheetIndex = CInt (WScript.Arguments.Item (5))
'To Read the Excel file
'ReadExcel gsFile, 1, 1, 30, 12, 2
'WScript.Echo "ReadExcel " , gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
ReadExcel gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
Else
'WScript.Echo "Usage: MyExcel.vbs sExcelFile iStartRow iStartCol iEndRow iEndCol iSheetIndex"
'WScript.Quit
ReadExcel gsFile, 1, 1, 30, 12, 2
End If
'ReadExcel gsFile, 1, 1, 30, 12, 2
'---------------------------------
' Method : ReadExcel
' Author : T. Palani Selvam
' Purpose : Reading Excel contents.
' Parameters: - Nil
' Returns : - Nil
' Caller : - Nil
' Calls : - Nil
' Revision History:
'
' [No] da-mon-year Name: Action:
' [ 1] 07-Nov-2007 Palani Created first version
'---------------------------------
Sub ReadExcel(sExcelFile, iStartRow, iStartCol, iEndRow, iEndCol, iSheetIndex)
'WScript.Echo "ReadExcel " , sExcelFile, iStartRow, iStartCol, iEndRow, iEndCol, iSheetIndex
'ReadExcel(sExcelFile As Variant, iStartRow As Integer, iStartCol As Integer, iEndRow As Integer, iEndCol As Integer,iSheetIndex As Integer)
' Purpose: For Excel verification
' To Read the Excel and write into a file
' Each cell content
' Each cell - Foreground color, font name, font style, font size and Background color.
Dim sExcelPath 'As Variant 'Excel file
'********** Excel object declaration **********'
' Excel Application object
Dim objExcel 'As Excel.Application
Dim objXLWorkbooks 'As Excel.Workbooks
Dim objXLWorkbook 'As Excel.Workbook
Dim WorkSheetCount 'As Variant 'Work sheets count in a excel
Dim CurrentWorkSheet 'As Excel.Worksheet ' Current worksheet
Dim objCells 'As Excel.Range
Dim objCurrentCell 'As Variant
Dim objFont 'As Variant
' Result contents
Dim sCellValue 'As Variant
Dim sShowCellValue 'As Variant
Dim sFontName 'As Variant
Dim sFontStyle 'As Variant
Dim iFontSize 'As Variant
Dim iBackColorIndex 'As Variant
Dim iForeColorIndex 'As Variant
Dim iBackColorIndex2 'As Variant
Dim iForeColorIndex2 'As Variant
Dim sResult 'As Variant
' Row and Col integer variables
Dim iUsedRowsCount 'As Integer
Dim iUsedColsCount 'As Integer
Dim iTop, iLeft 'As Integer
Dim iRow 'As Integer 'Row item
Dim iCol 'As Integer 'Col item
Dim iCurRow 'As Integer
Dim iCurCol 'As Integer
If (sExcelFile = "") Then
sExcelPath = "D:\VB\Contacts.xls"
Else
sExcelPath = sExcelFile
End If
if (iSheetIndex = "") Then
iSheetIndex =1
End If
FileDeleteAndCreate (gsLogFile)
'XL file check
If (FileExists (sExcelPath) <> 0) Then
LogWrite ("The Excel file " & Chr(34) & sExcelPath & Chr(34) & " does not exit!")
'WScript.Echo "The Excel file, " & Chr(34) & sExcelPath & Chr(34) & " does not exit!"
'WScript.Quit
Else
LogWrite ("The XL file " & sExcelPath & " exists.")
End If
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open sExcelPath, False, True
'WScript.Echo "Reading data from " & sExcelPath
' objExcel.ExecuteExcel4Macro
'On Error GoTo ErrorHandler1
On Error Resume Next
WorkSheetCount = objExcel.Worksheets.Count
'WScript.Echo "We have " & WorkSheetCount & " worksheets."
'Set objXLWorkbook = objExcel.Workbooks(1)
Set objXLWorkbook = objExcel.ActiveWorkbook
'objXLWorkbook.RunAutoMacros
Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(iSheetIndex) 'iSheetIndex worksheet
'Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(1) 'First worksheet
' CurrentWorkSheet = objExcel.Worksheets(1) 'First worksheet
iUsedRowsCount = iEndRow 'CurrentWorkSheet.UsedRange.Rows.Count
iUsedColsCount = iEndCol 'CurrentWorkSheet.UsedRange.Columns.Count
iTop = iStartRow 'CurrentWorkSheet.UsedRange.Row
iLeft = iStartCol 'CurrentWorkSheet.UsedRange.Column
' Cells object
CurrentWorkSheet.Cells.Activate
For iRow = iTop To iUsedRowsCount '(iUsedRowsCount - 1)
'Read All rows
For iCol = iLeft To iUsedColsCount '(iUsedColsCount - 1)
'Read all Columns
sResult = ""
Set objCurrentCell = CurrentWorkSheet.Cells(iRow, iCol)
sCellValue = objCurrentCell.Value
'If ((sCellValue = empty) Or (sCellValue = "empty")) Then
If ((sCellValue = empty)) Then
sCellValue = "empty"
Else
Set objFont = objCurrentCell.Font
sFontName = objFont.Name
sFontStyle = objFont.FontStyle
iFontSize = objFont.Size
iForeColorIndex = objFont.Color
iForeColorIndex2 = objFont.ColorIndex
If (sFontName = Empty) Then
sFontName = "empty"
End If
If (sFontStyle = Empty) Then
sFontStyle = "empty"
End If
If (iFontSize = Empty) Then
iFontSize = "-99999999"
End If
If (iForeColorIndex = Empty) Then
iForeColorIndex = "99999999"
End If
If (iForeColorIndex2 = Empty) Then
iForeColorIndex2 = "99999999"
End If
sResult = "Reading Cell {" & CStr(iRow) & "," & CStr(iCol) & "}," & sCellValue & "," & sFontName & "," & CStr(sFontStyle) & "," & CStr(iFontSize) & "," & CStr(iForeColorIndex) & "," & CStr(iForeColorIndex2)
LogWrite (sResult)
End If
Set objCurrentCell = Nothing
Next
Next
' This will prevent Excel from prompting us to save the workbook.
objExcel.ActiveWorkbook.Saved = True
Set CurrentWorkSheet = Nothing
'objExcel.Worksbooks.Close
objExcel.Quit
''Set CurrentWorkSheet = Nothing
Set objExcel = Nothing
MsgBox "Read COmpleted.", vbOKOnly, "Exec Over"
Exit Sub
ErrorHandler1:
MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear ' Clear the error.
End Sub
'---------------------------------
' Method : Logwrite
' Author : T. Palani Selvam
' Purpose : Append the given message into Log file.
' Parameters: sMsg - String, Contains logging message.
' Returns : - Nil
' Caller : - Nil
' Calls : - Nil
' Revision History:
'
' [No] da-mon-year Name: Action:
' [ 1] 07-Nov-2007 Palani Created first version
'---------------------------------
Sub LogWrite(sMsg)
Const ForAppending = 8
'FileName = "D:\VBs\Mysamples\1create.txt"
Set objFSO = CreateObject("scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (gsLogFile, ForAppending, True)
objTextFile.WriteLine date & " " & time & ": " & sMsg
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing
End Sub
'---------------------------------
' Method : FileExists
' Author : T. Palani Selvam
' Purpose : Checks the given file is avialable or not.
' Parameters: - Nil
' Returns : - Returns As Boolean
' Caller : - Nil
' Calls : - Nil
'---------------------------------
Function FileExists(strPathName)
'return 0 if a file exists else -1
Dim ObjFSO
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
if ObjFSO.FileExists(strPathName) = False then
FileExists = -1
else
FileExists = 0
end If
Set ObjFSO = Nothing
End Function
'---------------------------------
' Method : FileDeleteAndCreate
' Author : T. Palani Selvam
' Purpose : To delete the file if exists..
' Parameters: - Nil
' Returns : - Returns As Boolean
' Caller : - Nil
' Calls : - Nil
'---------------------------------
Function FileDeleteAndCreate(strFileName)
' delete
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objTextFile = objFSO.GetFile(strFileName)
objTextFile.Delete
Set objTextFile = objFSO.CreateTextFile(strFileName)
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing
End Function
'---------------------------------
' Method : Initialize
' Author : T. Palani Selvam
' Purpose : Initial actions & arrangements will be completed.
' Parameters: - Nil
' Returns : - Nil
' Caller : - Nil
' Calls : - Nil
'---------------------------------
Sub Initialize()
'CHECKING INPUT FILES ARE AVAILABLE OR NOT
gsLogFile = App.Path & "\Results.log"
End Sub
No comments:
Post a Comment