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)
错了。 Fls
是 collection.
您需要的是:
Set Fls = fldr.files
For Each thing in Fls
sFSpec = FSO.GetAbsolutePathName(thing)
因为您在循环中将每个文件放入一个名为 thing
的变量中。
我在 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)
错了。 Fls
是 collection.
您需要的是:
Set Fls = fldr.files
For Each thing in Fls
sFSpec = FSO.GetAbsolutePathName(thing)
因为您在循环中将每个文件放入一个名为 thing
的变量中。