Option Explicit

Dim strPath,strID

Dim objFSO

Dim objXML

Dim strResult

strPath = InputBox("Please input the path of your root folder: ")

strID = InputBox("Please input the ID which you want to search: ")

'创建FileSystemObject对象用于遍历文件夹

Set objFSO = CreateObject("Scripting.FileSystemObject")

'创建Microsoft.XMLDOM对象用于读取XML文件

Set objXML = CreateObject("Microsoft.XMLDOM")

'判断用户输入的根文件夹是否存在

If objFSO.FolderExists(strPath) Then

'    若根文件夹存在，则调用GetXMLInfo函数实现读取XML功能

    strResult = GetXMLInfo(strPath,strID)

Else

    MsgBox "Please input a valid forlder name."    

End If

'销毁objFSO和objXML对象

Set objFSO = Nothing

Set objXML = Nothing

'输出结果

If strResult <> "" Then

    MsgBox strResult

Else

    MsgBox "No records found!"

End If

Function GetXMLInfo(xmlPath,xmlID)

    Dim objFolders, objFolder

    Dim strFolderpath, strFilepath

    Dim objDocroot

    Dim strOutput,strXMLID,strXMLName,strXMLPath

'    获取子文件夹

    Set objFolders = objFSO.GetFolder(xmlPath).SubFolders

'    遍历子文件夹

    For Each objFolder In objFolders

'        通过路径拼接得到XML文件路径（因为每个XML文件名字相同，所以可以直接拼接得到XML文件路径）

        strFolderpath = objFolder.Path

        strFilepath = strFolderpath & "\TestFile.xml"

        If objFSO.FileExists(strFilepath) Then

'            读取XML文件

            objXML.load(strFilepath)

            Set objDocroot = objXML.documentElement                

            strXMLID = objDocroot.selectSingleNode("//xmlLable01/ID").text

            strXMLName = objDocroot.selectSingleNode("//xmlLable01/Name").text

            strXMLPath = strFilepath

'            拼接输出结果

            If xmlID = "" Then

                strOutput = strOutput & vbCrLf & vbCrLf & "ID: " & strXMLID & _

                vbCrLf & "Name: " & strXMLName & _

                vbCrLf & "XMLPath: " & strXMLPath 

            ElseIf InStr(strXMLID,xmlID) >0 Then

                strOutput = strOutput & vbCrLf & "ID: " & strXMLID & _

                vbCrLf & "Name: " & strXMLName & _

                vbCrLf & "XMLPath: " & strXMLPath 

                Exit For

            End If

'            销毁objDocroot对象

            Set objDocroot = Nothing

        End If

    Next

'    销毁objFolder及objFolders对象

    Set objFolder = Nothing

    Set objFolders = Nothing 

'    函数返回值

    GetXMLInfo = strOutput        

End Function