調用測試程序,打開某個指定文件夾里面所有“*.*”格式的文件,執行某些可控操作,然后存盤。
Sub testCases()
'打開一個文件夾(包括子文件夾)中的所有doc文件,執行相同的操作。
'吳增念 測試腳本。
Dim strPath As String
Dim strFileName As String
Dim docOutline As Document
Dim strFileNames() As String
Dim lFileNames As Long
'獲取文件夾路徑
strPath = ActiveDocument.Path '(也可以指定文件夾路徑 strPath = "c:\testCase" )
'call 下面一段函數。(路徑、后綴、文件名)
lFileNames = TreeSearch(strPath, "*.doc", strFileNames())
'從第2個文件開始執行操作
For idx = 2 To lFileNames
'/////////////////////////////////////////////////////////////////
'打開指定文件名
strFileName = strFileNames(idx)
If Len(strFileName) Then
Set docOutline = Application.Documents.Open(strFileName)
'to do
'關閉執行后的文件,不保存。(保存:wdPromptToSaveChanges ; 取消:wdSaveChanges)
ActiveWindow.View.Type = wdWebView
Selection.Orientation = wdTextOrientationVerticalFarEast
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:=6, DefaultTableBehavior.:=wdWord9TableBehavior, AutoFitBehavior.:=wdAutoFitFixed
ActiveDocument.Shapes.Range(1).Select
Selection.Delete
ActiveDocument.Save
End If
Next
End Sub
Public Function TreeSearch(ByVal strPath As String, ByVal strFileSpec As String, strFiles() As String) As Long
Static lFiles As Long
Dim lTemp As Long
Dim lIndex As Long
Dim strDir As String
Dim strSubDirs() As String
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strDir = Dir(strPath & strFileSpec)
Do While Len(strDir)
lFiles = lFiles + 1
ReDim Preserve strFiles(1 To lFiles)
strFiles(lFiles) = strPath & strDir
strDir = Dir
Loop
lIndex = 0
strDir = Dir(strPath & "*.*", vbDirectory)
Do While Len(strDir)
lPos = Len(strDir)
If Right(strDir, lPos) <> "." And Right(strDir, lPos) <> ".." Then
If GetAttr(strPath & strDir) And vbDirectory Then
lIndex = lIndex + 1
ReDim Preserve strSubDirs(1 To lIndex)
strSubDirs(lIndex) = strPath & strDir & "\"
End If
End If
strDir = Dir
Loop
For lTemp = 1 To lIndex
Call TreeSearch(strSubDirs(lTemp), strFileSpec, strFiles())
Next lTemp
TreeSearch = lFiles
End Function