[文章]：XML to EXCEL

fry

VBS编的代码：XML to EXCEL
<<I>script</I> language=vb<I>script</I>>


'**目的： 把XML串的内容生成Excel文件
'**输入:  strXML  XML字符串，
'**   格式如：<Root><Item 属性1＝'value1' 属性2＝'value2' ... />...</Root>
'**返回：
Sub SaveExcelFile(strXML)
  
  
  ' **变量定义和初始化
  Dim objXML
  Dim fileName
  
  Dim strHeader,strFileContent

  '** 创建XMLDOM对象
  Set objXML=CreateObject("MSXML2.DOMDocument")
  objXML.async=false
  objXML.loadXML(strXML)

  
  If objXML.parseError.errorCode<>0 then
   alert objXML.parseError.reason
  End if

  If objXML.documentElement.childNodes.length>=0 then
   
   '** 创建FileSystemObject对象
   Set fs=CreateObject("<I>script</I>ing.FileSystemObject")
   '读取客户端临时目录
   filepath = fs.GetSpecialFolder(2)

   '随机读取生成Excel文件的文件名
   'filename = fs.GetTempName
   'filename = replace(filename,"tmp","xls")
   set myFile=fs.CreateTextFile(FilePath & "\" & "查询结果.xls",true)
   
   '** 写表头
   For k=0 to objXML.documentElement.childNodes.Item(0).Attributes.length - 1
    strHeader=strHeader & objXML.documentElement.childNodes.Item(0).Attributes(k).nodeName & chr(9)
   next
   myFile.WriteLine strHeader
   
   '** 写每一行记录
   
   For i = 0 To objXML.documentElement.childNodes.length - 1
    For k = 0 To objXML.documentElement.childNodes.Item(i).Attributes.length - 1
             strFileContent=strFileContent & objXML.documentElement.childNodes.Item(i).Attributes(k).nodeValue & chr(9)
          Next
    myFile.Write strFileContent & chr(13)
    '** 清空StrFileContent的值
    strFileContent=""   
   Next
  End if

  '** 释放对象
  set objXML=nothing
  set myFile=nothing
  set fs=nothing
  
  '** 打开该Excel文件
  if Err.number=0 then
   window.open FilePath & "\" & "查询结果.xls","查询结果"
  else
   alert Err.De<I>script</I>ion
  end if
End Sub


Dim strXML
strXML = "<Root><node id='46' name='软件开发部' bb='aa'/><node id='47' name='市场部'/></Root>"  
SaveExcelFile strXML


' ** 删除查询结果的临时Excel文件
Sub closeWindow()
  Dim fileName,FilePath
  FileName="查询结果.xls"
  Dim fs
  
  '** 创建FileSystemObject对象
  Set fs=CreateObject("<I>script</I>ing.FileSystemObject")
  '读取客户端临时目录
  filepath = fs.GetSpecialFolder(2)
  if fs.FileExists(filePath & "\" &  filename) then
   fs.DeleteFile(filePath & "\" & filename)
  end if

End Sub
</<I>script</I>>