|
Option Explicit
Option Compare Text
Function vFilesListDg(ByVal strPath$, ByRef ar(), Optional ByRef iGroup&, _
Optional ByVal strExtension$ = "*", Optional ByVal strExclude As String = "")
Dim Fso As Object, objFold As Object, vFile, vFold
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFold = Fso.GetFolder(strPath)
For Each vFile In objFold.Files
If Fso.GetExtensionName(vFile.Name) Like strExtension Then
If vFile.Name <> strExclude And Not vFile.Name Like "~$*" Then
iGroup = iGroup + 1
ReDim Preserve ar(1 To 3, 1 To iGroup)
ar(1, iGroup) = objFold.Path & "\"
ar(2, iGroup) = vFile.Path
ar(3, iGroup) = Left(vFile.Name, InStrRev(vFile.Name, ".") - 1)
End If
End If
Next
For Each vFold In objFold.subfolders
vFilesListDg vFold, ar, iGroup, strExtension, strExclude
Next
End Function
Sub test()
Dim strFileName$, strPath$, ar(), i&
Call vFilesListDg(ThisDocument.Path, ar(), i, "txt", ThisDocument.Name)
If i = False Then Exit Sub
strPath = ThisDocument.Path & "\"
Application.ScreenUpdating = False
For i = 1 To UBound(ar, 2)
With Documents.Open(ar(2, i))
.SaveAs ar(1, i) & ar(3, i), wdFormatXMLDocument
.Close
End With
Next i
Application.ScreenUpdating = True
Beep
End Sub
|
评分
-
1
查看全部评分
-
|