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