Tuesday, January 11, 2011

Read/Write Excel Cell Value Via VBscript(ZT)

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1
'
' NAME:
'
' AUTHOR: bo , bo
' DATE  : 1/11/2011
'
' COMMENT:
'
'==========================================================================

Function  GetCellValue(excelSheet, row, column, path)
on error resume Next
Set  Wshshell  = CreateObject ( "Wscript.shell" )
Set  ExcelApp  = CreateObject ( "excel.Application" )
        ExcelApp.Visible  = True
Set  newBook  =  ExcelApp.Workbooks.Open(path)
If   Err  = 0 Then
Set  excelSheet  =  ExcelApp.ActiveSheet
                GetCellValue  =  excelSheet.Cells(row, column)
                ExcelApp.Quit
                Wshshell.Popup GetCellValue, 2 , " EXCEL VALUE : " , 0 + 64
Else
                Wshshell.Popup  " Please confirm file exists  " , 3 , " file not exist " , 0 + 64
                ExcelApp.Quit
End If
End Function
'Call  GetCellValue( "Sheet1" , 1 , 2 , "C:\excel.xls" )

Function  WriteExcel(row,col,value,path)
Set  Wshshell  = Createobject ( "Wscript.shell" )
        Err  = 0
on error resume next
Dim  fso,f
Set  fso  = CreateObject ( "Scripting.FileSystemObject" )
Set  f  =  fso.GetFile(path)
Set  ExcelApp  = CreateObject ( "Excel.Application" )
        ExcelApp.Visible  = true
If   Err  = 0 Then
Set  newBook  =  ExcelApp.Workbooks.Open(path)
                newBook.Worksheets( 1 ).Activate
                newBook.Worksheets( 1 ).Cells(row,col).value = value
                newBook.Worksheets( 1 ).Name = "Sheet1"
                newBook.Save
                ExcelApp.Application.quit
set  newBook  = nothing
Set  ExcelApp  = Nothing
Elseif  Err  = 53 Then
Set  newBook  =  ExcelApp.Workbooks.Add
                newBook.Worksheets( 1 ).Activate
                newBook.Worksheets( 1 ).Cells(row,col).value = value               
                newBook.Worksheets( 1 ).Name = "Sheet1"
                newBook.SaveAs path
                ExcelApp.Application.quit
set  newBook  = nothing
Set  ExcelApp  = nothing
Else
                Wshshell.Popup  " Unknown error" ,  5 ,  " can not continue " , 0 + 32
End If
End Function
Call  WriteExcel( 3 , 3 , "sadfasdfasdf" , "c:\excel.xls" )

0 Comments:

Post a Comment

<< Home