VBS如何读取EXCEL的数据？

鹭岛

如何EXCEL表中的列下面的行进行操作呢？

xyg111

请教关于这段程序的两个问题，
第一：如果让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

miichael

thank you

lyscser

读取：
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")

zte_boy

这样的列子太多了，自己找找吧

sogoc

有没有例子说来一个，我现在没安装QTP，我不是在弄QTP，我是在需找一个例子！
我是要进行简历参数后，然后新建一个EXCEL然后取得行值！

dreamever

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

Randall

在安装目录下就有很多关于Excel使用的好例子，楼主可以好好看看
C:\Program Files\Mercury Interactive\QuickTest Professional\CodeSamplesPlus\UsingExcel.vbs

kinglzj

很多种方法,可以用wsh
论坛里 百度 搜搜到处都是