的VBScript過程在一個目錄

我試過SO創建一個VBScript文件處理器，現有的許多答案，因爲我的解決方案的所有XML文件是各種不同的腳本，它給組合Me錯誤的VBScript過程在一個目錄

參數是不正確。

我想調試它，但任何提示都可以幫助我的時間表。

<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還有一個錯誤

類型不匹配的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實際的問題是與下面的代碼仍然沒有得到解決： -

參數不正確

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

來源

2016-03-02 Kailash Singh

首先，'Set sFSpec = fso.GetAbsolutePathName（Fls）'應該是'sFSpec = fso.GetAbsolutePathName（thing）'。接下來，在嘗試解析文件之前，你應該檢查文件的類型爲'.xml' – SearchAndResQ

我編輯了我的代碼，它似乎已經修復了一些問題，但不是全部 –

'Type Mismatch init'是因爲沒有sub /函數在你的代碼中調用'init'。你調用'身體Onload = Init' – SearchAndResQ

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變量。

來源

2016-03-02 10:48:33 SearchAndResQ

我沒有正確閱讀您的第一條評論，並且掙扎了好幾個小時。 –

你是一名學生。你__應該仔細閱讀:) – SearchAndResQ

多動症不是傑克的選擇！ ;） –

的VBScript過程在一個目錄

回答

相關問題