51Testing软件测试论坛

标题: VBS如何读取EXCEL的数据？ [打印本页]

作者: 鹭岛 时间: 2008-6-2 18:07
标题: VBS如何读取EXCEL的数据？
如何EXCEL表中的列下面的行进行操作呢？

作者: kinglzj 时间: 2008-6-2 19:32
很多种方法,可以用wsh
论坛里百度搜搜到处都是

作者: Randall 时间: 2008-6-2 19:59
在安装目录下就有很多关于Excel使用的好例子，楼主可以好好看看
C:\Program Files\Mercury Interactive\QuickTest Professional\CodeSamplesPlus\UsingExcel.vbs

作者: dreamever 时间: 2008-6-2 20:25
在百度上搜“vbs excel”能找到铺天盖地的资料，比我们在这里打字要节省不知多少时间，建议楼主试一下。

作者: sogoc 时间: 2008-6-2 20:42
有没有例子说来一个，我现在没安装QTP，我不是在弄QTP，我是在需找一个例子！
我是要进行简历参数后，然后新建一个EXCEL然后取得行值！

作者: zte_boy 时间: 2008-6-2 21:15
这样的列子太多了，自己找找吧

作者: lyscser 时间: 2008-6-2 21:36
读取：
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")

作者: miichael 时间: 2008-6-3 09:50
标题: 回复 3# 的帖子
thank you

作者: xyg111 时间: 2009-5-6 10:59
请教关于这段程序的两个问题，
第一：如果让VBS读取excel 中指定的sheet , 通过哪个方法实现？
第二：每次用这段程序的时候需要先关闭需要写的excel文件,然后程序读数据的时候会自动打开，程序写数据的时候自动关闭，能不能让程序判断，读数据的时候如果目标excel已经打开，则程序不再打开，写数据的时候如果目标excel已经打开，则程序不再保存excel（仅仅将结果写入目标excel文件）

下面是我改的程序
Public Function GetCellValue()

Dim excelSheet
Dim row
Dim PN_column
Dim System_column
Dim Supplier_column
Dim Brand_column
Dim path
Dim data(200,5)

excelSheet = "New Part"
PN_column = 3
System_column = 2
Supplier_column = 5
Status_column=6
Brand_column = 11
path = "d:/night shift.xls"

         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

            For i=2 To 199

If excelSheet.Cells(i, System_column)="" And excelSheet.Cells(i, PN_column)<>"" Then
                    MsgBox "the system name of " & excelSheet.Cells(i, PN_column)& " is blank, please fill it"
                  ElseIf  excelSheet.Cells(i, Supplier_column)="" And excelSheet.Cells(i, PN_column)<>"" Then
                    MsgBox "the supplier name of " & excelSheet.Cells(i, PN_column) & " is blank, please fill it"
                  'ElseIf  excelSheet.Cells(i, Brand_column)="" And excelSheet.Cells(i, PN_column)<>"" And UCase(Trim(excelSheet.Cells(i, System_column)))="EGP" And (UCase(Trim(excelSheet.Cells(i, Supplier_column)))="UNI LIPC" Or  UCase(Trim(excelSheet.Cells(i, Supplier_column)))="UNI MEX"  ) Then
                    'MsgBox  excelSheet.Cells(i, PN_column) & " is Thinkpad , Thinkcenter or Option? please fill it"
Else
data(i,1) = excelSheet.Cells(i, System_column)
                    data(i,2) = excelSheet.Cells(i, Supplier_column)
                    data(i,3) = excelSheet.Cells(i, PN_column)
                    data(i,4) = excelSheet.Cells(i, Status_column)
                    data(i,5)= excelSheet.Cells(i, Brand_column)
                  End If

              Next

              GetCellValue = data

            ExcelApp.Quit
      Else
            Wshshell.Popup "请确认文件是否已经创建",3,"文件不存在",0+64
            ExcelApp.Quit
      End If
End Function

Public Function WExcel(data)
Set Wshshell = Createobject("Wscript.shell")
Err = 0

On error resume Next

Dim fso
Dim f
Dim path
Dim Status_column
Dim Comments_column
Dim partial_view_column

path = "d:/night shift.xls"
Status_column = 6
Comments_column = 7
partial_view_column =12

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

            For i = 2 To 199
            If data(i,1) <> "" Then
                    newBook.Worksheets(1).Cells(i,Status_column).value=data(i,1)
                    newBook.Worksheets(1).Cells(i,Comments_column).value=data(i,2)
                    newBook.Worksheets(1).Cells(i,partial_view_column).value=data(i,3)
               End If
              next

            newBook.Worksheets(1).Name="New Part"
            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="New Part"
            newBook.SaveAs path
            ExcelApp.Application.quit
            set newBook = nothing
            Set ExcelApp = nothing
      Else
            Wshshell.Popup "发生未知错误", 5, "无法继续",0+32
      End If
End Function

欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/)