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

vbscript process all xml file in a directory

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

The Parameter is incorrect.

我正在尝试调试它,但如果有任何提示可以帮助我安排时间线,我们将不胜感激。

<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 添加了文件类型检查,但仍有一个错误

Type Mismatch init

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

<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 实际问题是以下代码仍未解决:-

The parameter is incorrect

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 Fls = fldr.files
For Each thing in Fls
        sFSpec = FSO.GetAbsolutePathName(Fls)

错了。 Flscollection.

您需要的是:

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

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