****************************
' Excel操作
'****************************
'****************************
' 定义Excel对象
' xlsApp Excel应用程序对象
' xlsWork Excel工作簿对象
'****************************
Dim xlsApp,xlsWork
'----------------------------------------------------------------------------------
'示例：调用获取excel当前路径并获取表中的使用的行数和列数
filepath = getpath() & "TestFramework.xls"
MsgBox filepath
xlsOpen(filepath)
xlsWork.WorkSheets("example").Activate
MsgBox "表中总共有" & xlsWork.WorkSheets("example").usedrange.rows.count & "行" '获取excel表中的所有使用行
MsgBox "表中总共有" & xlsWork.WorkSheets("example").usedrange.columns.count & "列" '获取excel表中的所有使用列
xlsClose()
'----------------------------------------------------------------------------------
'获取当前应用程序路径,把excel放到这个路径下以后就可以不用管路径问题了
function getpath()
dim wsheel
Set wsheel=wscript.createobject("wscript.shell")
getpath=wsheel.currentdirectory & "\"
End Function
'****************************
' 函数名称：xlsOpen
' 函数功能：打开Excel工作簿
' 参数1：fileName Excel文件名称(包括路径)
' /*参数2：sheetName Excel工作表名称*/
' 返回值：无
'****************************
Sub xlsOpen(fileName)
On Error Resume Next '遇见错误继续运行程序
Set xlsApp = CreateObject("Excel.Application") '创建应用程序对象
Set xlsWork = xlsApp.WorkBooks.open(fileName) '设置打开文件的对象
'xlsWork.WorkSheets(sheetName).Activate '设置当前活动的工作表
'如果有错误则关闭Excel程序
If ERR.Number<>0 Then
MsgBox "asdf"
Call xlsClose()
End If
On error goto 0
End Sub
'****************************
' 函数名称：xlsRead
' 函数功能：读取Excel表格中指定单元格的数据
' 参数1：sheetName 工作表名称
' 参数2：row 单元格所在行
' 参数3：col 单元格所在列
' 返回值：当前单元格的数据
'****************************
Function xlsRead(sheetName,row,col)
On Error Resume next
xlsRead = xlsWork.WorkSheets(sheetName).Cells(row,col).Value
'如果有错误则关闭Excel程序
If ERR.Number<>0 Then
Call xlsClose()
'Err.Clear()
End If
On error goto 0
End Function
'****************************
' 函数名称：xlsWrite
' 函数功能：写入数据到指定的Excle单元格
' 参数1：sheetName 工作表名称
' 参数2：row 单元格所在行
' 参数3：col 单元格所在列
' 参数4：val 要写入到单元格的数据
' 返回值：无
'****************************
Function xlsWrite(sheetName,row,col,val)
On Error Resume next
xlsWork.WorkSheets(sheetName).Cells(row,col).Value = val
'如果有错误则关闭Excel程序
If ERR.Number<>0 Then
Call xlsClose()
End If
On error goto 0
End Function
'****************************
' 函数名称：xlsSave
' 函数功能：保存Excel工作簿数据
' 参数：无
' 返回值：无
'****************************
Sub xlsSave()
On Error Resume next
xlsWork.Save
'xlsWork.SaveAs "C:\aa.xls" '另存为一个新文件
'如果有错误则关闭Excel程序
If ERR.Number<>0 Then
Call xlsClose()
End If
On error goto 0
End Sub
'****************************
' 函数名称：xlsClose
' 函数功能：关闭Excel工作簿
' 参数：无
' 返回值：无
'****************************
Sub xlsClose()
'关闭对象
xlsWork.Close
xlsApp.WorkBooks.Close
'清空对象
Set xlsWork = Nothing
Set xlsApp = Nothing
End Sub
'****************************
' word操作
'****************************
'****************************
' 定义word对象
' docApp word应用程序对象
' docWork word文档对象
'****************************
Dim docApp,docWord
'****************************
' 函数名称：docCreate
' 函数功能：创建word文档
' 参数：无
' 返回值：无
'****************************
Function docCreate()
On Error Resume Next
Set docApp = CreateObject("Word.Application")
Set docWord = docApp.Documents.Add()
'如果有错误则关闭Word程序
If ERR.Number<>0 Then
Call docClose()
End If
On error goto 0
End Function
'****************************
' 函数名称：docWrite
' 函数功能：向word文档中写入数据
' 参数1：val 要写入的数据
' 参数2：dataType 写入数据的类型，text代表文本，bmp代表图像
' 返回值：无
'****************************
Function docWrite(val,dataType)
On Error Resume Next
Select Case dataType
Case "text"
docApp.Selection.TypeText val
Case "bmp"
docApp.Selection.InlineShapes.AddPicture val,false,true
End Select
'如果有错误则关闭Word程序
If ERR.Number<>0 Then
Call docClose()
End If
On error goto 0
End Function
'****************************
' 函数名称：docSave
' 函数功能：保存word文档
' 参数：fileName 保存的文件路径以及名称
' 返回值：无
'****************************
Function docSave(fileName)
On Error Resume Next
docWord.SaveAs fileName
'如果有错误则关闭Word程序
If ERR.Number<>0 Then
Call docClose()
End If
On error goto 0
End Function
'****************************
' 函数名称：docClose
' 函数功能：关闭word文档
' 参数：无
' 返回值：无
'****************************
Function docClose()
'关闭工作文档并退出Word应用程序
docWord.close
docApp.Quit
'清空对象
Set docWord=nothing
Set docApp=nothing
End Function
'****************************
' QTP对象操作
