http://blog.csdn.net/candle806/article/details/7490599

 

以下是通过VBScript实现的Excel数据转换成XML格式，主要用于实现Testlink1.9.3的测试用例导入。代码实现如下：

Dim objexcel,objworkbook,objsheet,objxml_inter,objxml,totalrow,row,id,excelStr

'========================================

'创建Excel对象,关闭Excel对象--函数

'=========================================

Function getExcel(excelname, excelpath)

Set objexcel = CreateObject("excel.application")

Set objworkbook = objexcel.Workbooks.Open(excelpath)

Set objsheet = objworkbook.Sheets(excelname)

End Function

Function clsExcel()

objworkbook.Close

End Function

'============================================

Function dealStr(excelStr)

    For id=2 to 8

    excelStr = Replace(excelStr,id&"、","<br/>"&id&"、")

    excelStr = Replace(excelStr,id&".","<br/>"&id&".")

    Next

    dealStr=excelStr

End Function

'========================

'获取Excel单元格数据,并将XML的格式写入到对应的单元格，之后通过创建XML对象生成XML文件

'========================

Function getExcelData()

row=2

objxml_inter=""

Do While Not (objsheet.cells(row,2).value ="")

'testcase

objxml_inter=objxml_inter&CStr("   <testcase internalid=""02"" name=""")

objxml_inter=objxml_inter&CStr(dealStr(objsheet.cells(row,2)))

objxml_inter=objxml_inter&CStr(""">")

objxml_inter=objxml_inter&CStr("<node_order><![CDATA[0]]></node_order>")

objxml_inter=objxml_inter&CStr("<externalid><![CDATA[7]]></externalid>")

'summary

objxml_inter=objxml_inter&CStr("<summary><![CDATA[<p>")

objxml_inter=objxml_inter&CStr(dealStr(objsheet.cells(row,3)))

objxml_inter=objxml_inter&CStr("</p>]]></summary>")

'preconditions

objxml_inter=objxml_inter&CStr("<preconditions><![CDATA[<p>")

objxml_inter=objxml_inter&CStr(dealStr(objsheet.cells(row,6)))

objxml_inter=objxml_inter&CStr("</p>]]></preconditions>")

'execution_type

objxml_inter=objxml_inter&CStr("<execution_type><![CDATA[1]]></execution_type>")

'importance

objxml_inter=objxml_inter&CStr("<importance><![CDATA[2]]></importance>")

'steps

objxml_inter=objxml_inter&CStr("<steps>")

'step

objxml_inter=objxml_inter&CStr("<step>")

'step_number

objxml_inter=objxml_inter&CStr("<step_number><![CDATA[1]]></step_number>")

'action

objxml_inter=objxml_inter&CStr("<actions><![CDATA[<p>")

objxml_inter=objxml_inter&CStr(dealStr(objsheet.cells(row,7)))

objxml_inter=objxml_inter&CStr("</p>]]></actions>")

'expectedresults

objxml_inter=objxml_inter&CStr("<expectedresults><![CDATA[<p>")

objxml_inter=objxml_inter&CStr(dealStr(objsheet.cells(row,8)))

objxml_inter=objxml_inter&CStr("</p>]]></expectedresults>")

'execution_type

objxml_inter=objxml_inter&CStr("<execution_type><![CDATA[1]]></execution_type>")

objxml_inter=objxml_inter&CStr("</step>")

objxml_inter=objxml_inter&CStr("</steps>")

objxml_inter=objxml_inter&CStr("   </testcase>")

'CStr(objsheet.cells(x,1)),CStr(objsheet.cells(x,2))

'MyFile.Write(objxml_inter)

'WScript.Echo x-1

row=row+1

Loop

totalrow = row-2

End Function

'========================

'创建XML文件

'========================

Sub CreateXML

Dim fileObj, XmlFile

Set fileObj = CreateObject("Scripting.FileSystemObject")

Set XmlFile = fileObj.CreateTextFile(XMLname, True)

'xml title

objxml=CStr("<?xml version=""1.0"" encoding=""GBK""?>")

objxml=objxml&CStr("<testcases>")

objxml=objxml&objxml_inter

objxml=objxml&CStr("</testcases>")

XmlFile.Write(objxml)

XmlFile.Close

End Sub

excelpath = Inputbox("请输入Excel文件正确的路径名和文件名：","TestLink 1.9.3小助手: Excel转换XML工具")

If excelpath = "" Then

    MsgBox "文件名不能为空！"

    WScript.Quit

ElseIf  InStr(excelpath,".xls") < 1 Then

    MsgBox "文件名格式不对！"

    WScript.Quit

End If

excelname = InputBox("请输入Excel中所要操作的表格名称：","TestLink 1.9.3小助手: Excel转换XML工具")

If excelname = "" Then

    MsgBox "文件名不能为空！"

    WScript.Quit

End If

XMLname = InputBox("请输入转换之后的XML文件保存路径和名称：","TestLink 1.9.3小助手: Excel转换XML工具")

If XMLname = "" Then

    MsgBox "文件名不能为空！"

    WScript.Quit

ElseIf  InStr(XMLname,".xml") < 1 Then

    MsgBox "文件名格式不对！"

    WScript.Quit

End If

'初始化excel对象

Call getExcel(excelname, excelpath)

'读入Excel数据

Call getExcelData()

'写入数据， XML

CreateXML

'关闭Excel对象

Call clsExcel()

'提示信息

MsgBox "完成从Excel到XML的数据转换，总共"+CStr(totalrow)+"条！"