VBS如何读取EXCEL的数据？
如何EXCEL表中的列下面的行进行操作呢？ 很多种方法,可以用wsh论坛里 百度 搜搜到处都是 在安装目录下就有很多关于Excel使用的好例子，楼主可以好好看看
C:\Program Files\Mercury Interactive\QuickTest Professional\CodeSamplesPlus\UsingExcel.vbs 在百度上搜“vbs excel”能找到铺天盖地的资料，比我们在这里打字要节省不知多少时间，建议楼主试一下。 有没有例子说来一个，我现在没安装QTP，我不是在弄QTP，我是在需找一个例子！
我是要进行简历参数后，然后新建一个EXCEL然后取得行值！ 这样的列子太多了，自己找找吧 读取：
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)
IfErr = 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
IfErr = 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")
回复 3# 的帖子
thank you 请教关于这段程序的两个问题，第一：如果让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)
IfErr = 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"
ElseIfexcelSheet.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"
'ElseIfexcelSheet.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" OrUCase(Trim(excelSheet.Cells(i, Supplier_column)))="UNI MEX") Then
'MsgBoxexcelSheet.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
IfErr = 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
页:
[1]
