VBScript操作Excel

以下是一些VBScript操作Excel的实例，比如如何通过VbS打开Excel，新建Excel、Sheet，删除

Sheet，另存Excel文件，在指定的Sheet Cells中写入以及读取Sheet中usedRange中的内容。

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example1
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 打开Excel文件
'==========================================================================
Dim xlsApp,xlsWorkBook,xlsSheet
Dim iRowCount,numAdd
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\data.xls") '打开指定路径的Excel表格
Set xlsSheet = xlsWorkBook.Sheets("sheet1") '选择指定Sheet1
iRowCount = xlsSheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数
For iLoop = 2 To iRowCount
numAdd = xlsSheet.Cells(iLoop,1) '取Cells中的值
MsgBox iLoop '显示第一列从第二行开始到iLoop行为止。
Next
xlsWorkBook.Save
xlsWorkBook.Close
xlsApp.Quit
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example2
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 打开Excel文件
'==========================================================================
rem 打开Excel文件,Excel及sheet2需预先建立，不然找不到要打开的文件
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\weibin\2010.xls")'打开指定路径的Excel表格
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsSheet = xlsApp.Sheets.Item("Sheet2")'选择指定Sheet2
xlsWorkBook.Save '保存工作表
'xlsApp.Quit '退出Excel对象
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 将上面的一段程序封装成Function函数，Exel文件路径作为参数。
Function OPenExcelFile(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
Set xlsWorkBook = xlsApp.Workbooks.Open (FilePath)'打开指定路径的Excel表格
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsSheet = xlsApp.Sheets.Item("Sheet2")'选择指定Sheet2页
xlsWorkBook.Save '保存工作表
'xlsApp.Quit '退出Excel对象
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example3
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 另存Excel文件
'==========================================================================
rem 新建Excel文件并保存到一个指定位置，并在Sheet2中写入值
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '定义一个Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(2) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
xlsSheet.Cells(1,1).Value = "Hello World!" '在单元格录入Hello World
xlsApp.ActiveWorkbook.SaveAs ("d:\test.xls") '保存工作表
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 将上面的一段程序封装成Function函数，Exel文件路径作为参数。
Function CreateExcelFile(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet

Set xlsApp = WScript.CreateObject("Excel.Application") '定义一个Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(2) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
xlsSheet.Cells(1,1).Value = "Hello World!" '在单元格录入Hello World
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存工作表
xlsApp.Quit '退出

Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example4
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 添加新的Sheets并且命名另存
'==========================================================================
rem excel新建，sheet新建，重命名后另存
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
Set xlsSheet = xlsWorkBook.Sheets.Add() '新建一新Sheet
xlsSheet.name "Practise" '新Sheet命名为Practise
xlsSheet.activate '激活sheet
xlsSheet.range("A1:B5").Value = "Hello World" '在新sheet range A1至B5中中写入Hello World
xlsApp.ActiveWorkbook.SaveAs "D:\weibin\Hope.xls" '保存Excel至D:\weibin
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存

rem 封装AddSheets函数
Function AddSheets(FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
Set xlsSheet = xlsWorkBook.Sheets.Add() '新建一新Sheet
xlsSheet.name "Practise" '新Sheet命名为Practise
xlsSheet.activate '激活sheet
xlsSheet.range("A1:B5").Value = "Hello World" '在新sheet range A1至B5中中写入Hello World
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存Excel至D:\weibin
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
AddSheets "c:\weibin\hope.xls"

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example5
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 删除新建Excel指定的Sheet
'==========================================================================
Rem 删除指定的Sheet1,设定不同的n，可以删除不同的Sheet
Function DeleteSheet(n)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
Set xlsWorkBook = xlsapp.Workbooks.Add()  '新建一Excel实例
xlsApp.Visible = True '显示Excel对象
xlsWorkBook.Worksheets("Sheet"&n).Delete
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
DeleteSheet(1)

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example6
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-1-31
' COMMENT: 创建，写入，保存Excel文件
'==========================================================================
Function CreateWriteSaveAsExcelFile(n,i,j,FilePath)
Dim xlsApp,xlsWorkBook,xlsSheet
Set xlsApp = WScript.CreateObject("Excel.Application") '新建一Excel实例
Set xlsWorkBook = xlsApp.Workbooks.Add()  '新建一Excel实例
xlsapp.Visible = True '显示Excel对象
Set xlsSheet = xlsApp.Sheets.Item(n) '获取工作簿的第二个Sheet页
' xlsApp.Sheets.Item(2).Select '与上一句有相同的功能
' xlsWorkBook.Worksheets("Sheet1").activate '与上一句有相同功能
xlsSheet.Cells(i,j).Value = "For Testing" '在单元格录入For Testing
' xlsWorkBook.Worksheets("Sheet2").Cells(1,1).Value = "For Testing" '与上一句有相同功能
xlsApp.ActiveWorkbook.SaveAs (FilePath) '保存工作表
xlsApp.Quit '退出
Set xlsSheet = Nothing '释放内存
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
End Function
CreateWriteSaveAsExcelFile (1,2,2,"c:\weibin\Practice.xls")

'==========================================================================
' VBScript. Source File -- Created with SAPIEN Technologies PrimalScript. 4.1
' NAME:Example7
' AUTHOR: Weibin , cpic-ing
' DATE  : 2011-3-10
' COMMENT: 比较InsuredNo，若相同写入新创建的Sheet中

'==========================================================================
Option Explicit
On Error Resume Next
'定义相关变量
Dim xlsApp,xlsWorkBook,xlsSheet
Dim iRowCount
Dim a()
Dim b()
Dim oLoop,xLoop,jLoop
Dim i
Dim rowCount

Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
xlsApp.Visible = True 'true 为显示excel对象，false为不显示
Set xlsWorkBook = xlsApp.Workbooks.Open ("d:\tmp001.xlsx") '打开指定路径的Excel表格
Set xlsSheet = xlsWorkBook.Sheets.add()'
xlsWorkBook.ActiveSheet.Name = "Collection"
xlsSheet.Cells(1,1).Value = "InsuredNo"
xlsSheet.Cells(1,2).Value = "ContNo"
xlsWorkBook.ActiveSheet.Rows(1).Font.Bold = True

Set xlsSheet = xlsWorkBook.Sheets("SQL Results") '选择指定Sheet1
iRowCount = xlsSheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数

'声明动态数组变量并分配或重新分配存储空间
WScript.Echo "通知:声明动态数组变量并分配或重新分配存储空间开始，请等待!"
ReDim a(iRowCount-2)
ReDim b(iRowCount-2)
WScript.Echo "通知:声明动态数组变量并分配或重新分配存储空间成功!"

'文件中逐行读取，并记录数到组a，b中
WScript.Echo "通知:读取InsuredNo和ContNo到数组a,b开始!，读取完后有提示，请耐心等待!"
For Loop = 0 To iRowCount - 2
a(oLoop)= xlsSheet.Cells(oLoop + 2,27).Value
b(oLoop)= xlsSheet.Cells(oLoop + 2,3).Value
Next
WScript.Echo "通知:读取InsuredNo和ContNo到数组a,b成功!"
 
' 比较InsuredNO
WScript.Echo "通知:数据筛选开始，请耐心等待!"
Set xlsSheet = xlsWorkBook.Sheets("Collection") '选择指定Sheet1
For xLoop = 0 To iRowCount - 2
For jLoop = xLoop + 1 To iRowCount - 2
If a(xLoop) = a(jLoop) Then
xlsApp.Worksheets("Collection").Cells(xLoop + 2,1).Value = a(jLoop)
xlsApp.Worksheets("Collection").Cells(xLoop + 2,2).Value = b(jLoop)
End If
Next
Next
WScript.Echo "通知:数据筛选完成，并写入Excel中成功!"
xlsWorkBook.Save
xlsWorkBook.Close
xlsApp.Quit
Set xlsApp = Nothing  '释放Excel对象
Set xlsWorkBook = Nothing '释放内存
Set xlsSheet = Nothing '释放内存
WScript.Echo "通知:保存并关闭Excel，释放内存成功!"

tmp001.rar(465 KB)