S.l.e!ep.￠%

像打了激速一样，以四倍的速度运转，开心的工作
简单、开放、平等的公司文化；尊重个性、自由与个人价值；
posts - 1098, comments - 335, trackbacks - 0, articles - 1
  C++博客 :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理

VBScript读取 Excel 与 写入 Excel

Posted on 2008-10-21 21:41 S.l.e!ep.￠% 阅读(3425) 评论(0)  编辑 收藏 引用 所属分类: VBScript
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单元格的值为： " , 0 + 64
          Else
                Wshshell.Popup  " 请确认文件是否已经创建 " , 3 , " 文件不存在 " , 0 + 64
                ExcelApp.Quit
          End   If
End Function
Call  GetCellValue( " excel " , 9 , 9 , " E:/excel.xls " )

写入：
 Function  WExcel(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 = " excel "
                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 = " excel "
                newBook.SaveAs path
                ExcelApp.Application.quit
                 set  newBook  =   nothing
                 Set  ExcelApp  =   nothing
          Else
                Wshshell.Popup  " 发生未知错误 " ,  5 ,  " 无法继续 " , 0 + 32         
          End   If
End Function
Call  WExcel( 9 , 9 , " liuyi " , " E:/excel.xls " )

只有注册用户登录后才能发表评论。
网站导航: 博客园   IT新闻   BlogJava   博问   Chat2DB   管理