vbscript 处理目录中的所有xml文件答案

【问题标题】：vbscript process all xml file in a directoryvbscript 处理目录中的所有xml文件
【发布时间】：2016-03-02 05:54:41
【问题描述】：

我在 SO 上尝试了许多现有答案来创建 vb-script 文件处理器，因为我的解决方案是各种不同脚本的组合，这给了我错误

参数不正确。

我正在尝试对其进行调试，但感谢任何可能对我的时间线有所帮助的提示。

<HTML> 
<HEAD><TITLE>Simple Validation</TITLE> 

 <HTA:APPLICATION APPLICATIONNAME="Simple HTA" SYSMENU="yes">
    <title>Simple HTA</title>

<style type="text/css">
      body {background-color:lightsteelblue;}
          p {font:bold 18px arial;}

          #directory, #search
        {
            height:50px;
            width:500px;
            font-size:14pt;
        }
    </style>

<SCRIPT LANGUAGE="VBScript">
Dim DirectoryName
Dim Searchterm
Dim FSO
Dim objOutFile
Dim sFSpec
Dim objMSXML



Sub Browse
    On Error Resume Next
    Set bffShell = CreateObject("Shell.Application")
    Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
    If Err.number<>0 Then
        MsgBox "Error Setting up Browse for Folder"
    Else
        A = bff.ParentFolder.ParseName(bff.Title).Path
        If err.number=424 then err.clear
                tb2.value = A
    End If
End Sub

Sub Search
    On Error Resume Next
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite "user\Destop\VBS\Searchterm", tb1.value
    WshShell.RegWrite "user\Destop\VBS\Directory", tb2.value
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objOutFile = fso.CreateTextFile("results.txt",True)

    Set objMSXML = CreateObject("Msxml2.DOMDocument")
    objMSXML.setProperty "SelectionLanguage", "XPath"

    DirectoryName = tb2.value
    Searchterm = tb1.value
    IterateSearch DirectoryName
End Sub

Sub IterateSearch(FolderPath)
    On Error Resume Next
    Set fldr = fso.GetFolder(FolderPath)
    Set Fls = fldr.files
    For Each thing in Fls
        Set sFSpec = fso.GetAbsolutePathName(Fls)
        objMSXML.async = False
        objMSXML.load sFSpec
        If 0 = objMSXML.parseError Then
            Dim sXPath   : sXPath       =  "//*[local-name()='namespace']/*[local-name()='querySubject']/*[local-name()='queryItem'][contains(., 'REPORTING_RUN_ID')]/ancestor-or-self::*/*[local-name()='name']"

             Dim querySubject : Set querySubject = objMSXML.selectSingleNode(sXPath)
            If querySubject Is Nothing Then
                MsgBox sXPath, "failed"
            Else
            For Each node In objMSXML.selectNodes(sXPath)
                tag.innerHtml = tag.innerHtml & node.text & " "& "***" &"<br>" 
                ObjOutFile.WriteLine Linenum & "  " & thing.path
            Next
            End If
        Else
            MsgBox objMSXML.parseError.reason
        End If
    Next
        Set fldrs = fldr.subfolders
        For Each thing in fldrs
        IterateSearch thing.path
        Next
End Sub

Sub Init
    On Error Resume Next
    Set WshShell = CreateObject("WScript.Shell")
    tb1.value = WshShell.RegRead("user\Destop\VBS\Searchterm")
    tb2.value = WshShell.RegRead("user\Deskop\VBS\Directory")
End Sub

</script>
</head>
<body Onload=Init><p>This Simple HTA to search strings</p>

<p><INPUT Name=tb1 id=search TYPE=Text Value="ValuetoSearch" placeholder = "Input String to search">
<p><INPUT Name=tb2 id=directory TYPE=Text Value="E:\Users\xyz\Desktop\xml" placeholder="Directory to search"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick="Search"> <INPUT NAME="Clear" TYPE="BUTTON" VALUE="Clear" OnClick="window.location.reload()"></p>

<p id = "tag"></p>


</body>

<script language="javascript" type="text/javascript">
  window.resizeTo(640,480);
</script>

</html>

编辑 1:- 为 xml 添加文件类型检查仍然有一个错误

类型不匹配初始化

但是现在只有少数代码可以工作。

<HTML> 
<HEAD><TITLE>Simple Validation</TITLE> 

 <HTA:APPLICATION APPLICATIONNAME="Simple HTA" SYSMENU="yes">
    <title>Simple HTA</title>

<style type="text/css">
      body {background-color:lightsteelblue;}
          p {font:bold 18px arial;}

          #directory, #search
        {
            height:50px;
            width:500px;
            font-size:14pt;
        }
    </style>

<SCRIPT LANGUAGE="VBScript">
Dim DirectoryName
Dim Searchterm
Dim FSO
Dim objOutFile
Dim sFSpec
Dim objMSXML



Sub Browse
    On Error Resume Next
    Set bffShell = CreateObject("Shell.Application")
    Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
    If Err.number<>0 Then
        MsgBox "Error Setting up Browse for Folder"
    Else
        A = bff.ParentFolder.ParseName(bff.Title).Path
        If err.number=424 then err.clear
                tb2.value = A
    End If
End Sub

Sub Search
    On Error Resume Next
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.RegWrite "user\Destop\VBS\Searchterm", tb1.value
    WshShell.RegWrite "user\Destop\VBS\Directory", tb2.value
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objOutFile = fso.CreateTextFile("results.txt",True)

    Set objMSXML = CreateObject("Msxml2.DOMDocument")
    objMSXML.setProperty "SelectionLanguage", "XPath"

    DirectoryName = tb2.value
    Searchterm = tb1.value
    IterateSearch DirectoryName
End Sub

Sub IterateSearch(FolderPath)
    On Error Resume Next
    Set fldr = fso.GetFolder(FolderPath)

    Set Fls = fldr.files
    For Each thing in Fls
        if thing.type = ".xml" then
            sFSpec = FSO.GetAbsolutePathName(Fls)
            objMSXML.async = False
            objMSXML.load sFSpec
             If 0 = objMSXML.parseError Then
                Dim sXPath   : sXPath       =  "//*[local-name()='namespace']/*[local-name()='querySubject']/*[local-name()='queryItem'][contains(., 'REPORTING_RUN_ID')]/ancestor-or-self::*/*[local-name()='name']"

                Dim querySubject : Set querySubject = objMSXML.selectSingleNode(sXPath)
                    If querySubject Is Nothing Then
                        MsgBox sXPath, "failed"
                    Else
                        For Each node In objMSXML.selectNodes(sXPath)
                        demo.innerHtml = demo.innerHtml & node.text & " "& "***" &"<br>" 
                        ObjOutFile.WriteLine Linenum & "  " & thing.path
                        Next
                     End If
              Else
                 MsgBox objMSXML.parseError.reason
            End If
          Else
             Set contents = thing.OpenAsTextStream
             If err.number = 0 then
                Test = Instr(strLine, searchterm) 
                If Isnull(Test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path 
                demo.innerHtml = demo.innerHtml & thing.path  & "<br>"

                demo1.innerHtml = demo1.innerHtml & thing.name  & "<br>"
            Else
                err.clear
            End If
          End If
Next

        Set fldrs = fldr.subfolders
        For Each thing in fldrs
            IterateSearch thing.path
        Next

End Sub

</script>
</head>
<body Onload=Init><p>This Simple HTA to search strings</p>

<p><INPUT Name=tb1 id=search TYPE=Text Value="searchValue" placeholder = "Input String to search">
<p><INPUT Name=tb2 id=directory TYPE=Text Value="C:\Users\Desktop\xml" placeholder="Directory to search"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick="Search"> <INPUT NAME="Clear" TYPE="BUTTON" VALUE="Clear" OnClick="window.location.reload()"></p>

<ul id = "demo">
<ul id = "demo1"></ul>
</ul>


</body>

<script language="javascript" type="text/javascript">
  window.resizeTo(640,480);
</script>

</html>

编辑 2 实际问题是以下代码仍未解决：-

参数不正确

Sub IterateSearch(FolderPath)
    On Error Resume Next
    Set fldr = fso.GetFolder(FolderPath)

    Set Fls = fldr.files
    For Each thing in Fls
            sFSpec = FSO.GetAbsolutePathName(Fls)
            objMSXML.async = False
            objMSXML.load sFSpec
             If 0 = objMSXML.parseError Then
                Dim sXPath   : sXPath       =  "//*[local-name()='namespace']/*[local-name()='querySubject']/*[local-name()='queryItem'][contains(., 'REPORTING_RUN_ID')]/ancestor-or-self::*/*[local-name()='name']"

                Dim querySubject : Set querySubject = objMSXML.selectSingleNode(sXPath)
                    If querySubject Is Nothing Then
                        MsgBox sXPath, "failed"
                    Else
                        For Each node In objMSXML.selectNodes(sXPath)
                        xmldoc.innerHtml = xmldoc.innerHtml & node.text & " "& "***" &"<br>" 
                        ObjOutFile.WriteLine Linenum & "  " & thing.path
                        Next
                     End If
              Else
                 MsgBox objMSXML.parseError.reason
            End If   
Next

        Set fldrs = fldr.subfolders
        For Each thing in fldrs
            IterateSearch thing.path
        Next

End Sub

【问题讨论】：

首先，Set sFSpec = fso.GetAbsolutePathName(Fls) 应该是 sFSpec = fso.GetAbsolutePathName(thing)。接下来，您应该在尝试解析文件之前检查文件是否为.xml 类型
我已经编辑了我的代码，它似乎解决了一些问题，但不是全部
Type Mismatch init 是因为您的代码中没有名为 init 的子/函数。你打电话给body Onload=Init
在 xml 解析代码中仍然没有改进它仍然给出同样的错误....clueless
天哪！再次阅读我的第一条评论。请。

标签： xml xpath vbscript hta

【解决方案1】：

Set Fls = fldr.files
For Each thing in Fls
        sFSpec = FSO.GetAbsolutePathName(Fls)

错了。 Fls 是 collection。

你需要的是：

Set Fls = fldr.files
For Each thing in Fls
        sFSpec = FSO.GetAbsolutePathName(thing)

因为您在循环中将每个文件放入名为thing 的变量中。

【讨论】：

我没有正确阅读您的第一条评论并且挣扎了好几个小时。
多动症不是杰克的选择！ ;)