faysky2() 老兄，还得麻烦你一下呀

Question

faysky2() 老兄
   你给的代码我试过了,可只能消除指定的某个.doc文件,我现在需要的是一次把几百个word文件的页眉都改掉(不是删除,A该为B)。这个问题已经解决了
   
   现在的问题是几百个word文件一次性改掉，而这几百个word文件在几个不同的文件夹中，但都在同一个盘中，我希望的是在程序中把他给写死。运行一次，程序可以把这些Word文件一次性改掉。

Answer 1

是不是这样：
只要是那个盘中的.doc文件，就改掉它的页眉？

Answer 2

如果是的话，那么遍历那个磁盘，取得所有的doc文件的路径及名称，然后以各个doc文件的路径及名称作为参数，调用那个修改页眉函数就行了

Answer 3

对,就是这个意思,但在VB中,怎样才能遍历那个磁盘，取得所有的doc文件的路径及名称呢?

Answer 4

'遍历那个磁盘，取得所有的doc文件的路径及名称(假设是D盘)：Public Sub SeachFile(ByVal strPath As String)
    Dim Fso As Object
    Dim Fol As Object
    Dim Fil As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fol = Fso.GetFolder(strPath)
    
    For Each Fil In Fol.Files
        If LCase(Fso.GetExtensionName(Fil.Path)) = "doc" Then  '判断文件的扩展名是否为doc
            ClearText Fil.Path  '在这里调用修改页眉函数，参数就是Fil.Path
        End If
    Next
    For Each Fol In Fol.SubFolders
         SeachFile Fol
    Next
End SubPrivate Sub Command1_Click()
    SeachFile ("D:\")
End Sub

Answer 5

Public Function SeachFile(PathStr As String, ExtensionName As String) As LongDim Fso As FileSystemObject
Dim Fols As Folders
Dim Fol As Folder
Dim Fils As Files
Dim Fil As File
 If Right(PathStr, 1) <> "\" Then PathStr = PathStr & "\"
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set Fol = Fso.GetFolder(PathStr)
  Set Fils = Fol.Files
  
   For Each Fil In Fol.Files
       If Fso.GetExtensionName(Fil.Name) = ExtensionName Then
         Debug.Print Fil.Path & "\" & Fil.Name
         SeachFile = SeachFile + 1
      End If
   Next
     DoEvents
    Set Fols = Fol.SubFolders
    For Each Fol In Fols
       Call SeachFile(Fol.Path, ExtensionName)
    NextEnd Function