лично я предпочитаю работать с Scripting.FileSystemObject; как правило, с ним проще работать, чем анализировать и перекомпоновывать выходные данные функции VBA Dir. Добавьте ссылку на библиотеку Microsoft Scripting Runtime через Инструменты -> Ссылки ... .
Я бы предложил использовать следующие функции:
Public Function GetFiles(ByVal roots As Variant) As Collection
Select Case TypeName(roots)
Case "String", "Folder"
roots = Array(roots)
End Select
Dim results As New Collection
Dim fso As New Scripting.FileSystemObject
Dim root As Variant
For Each root In roots
AddFilesFromFolder fso.GetFolder(root), results
Next
Set GetFiles = results
End Function
Private Sub AddFilesFromFolder(folder As Scripting.folder, results As Collection)
Dim file As Scripting.file
For Each file In folder.Files
results.Add file
Next
Dim subfolder As Scripting.folder
For Each subfolder In folder.SubFolders
AddFilesFromFolder subfolder, results
Next
End Sub
Он принимает путь или объект Scripting.Folder (или массив того и другого) и возвращает коллекцию объектов File для каждого файла во всех подпапках для переданных в папке (папках).
Тогда вы можете написать свой код следующим образом:
Sub ConvertReturns()
'This Sub loops through docx files in a folder recursively, opens each file, finds manual line breaks, replaces each with a paragraph return, saves changed file to a new folder, closes original file.
Dim targetFolder As String
Dim oFile As Scripting.file, oFso As New Scripting.FileSystemObject
Dim oDoc As Document, oRng As Range
Dim fileName As String, fileExtension As String
Dim targetPath As String
'Set paths to folders for original and converted files on user's hard drive.
Const sourceFolder = "C:\Users\Administrator\Desktop\Unprocessed\"
targetFolder = "C:\Users\Administrator\Desktop\Processed\"
'Repeat the following code for each File object in the Collection returned by GetFiles
For Each oFile In GetFiles(sourceFolder)
'This handles any Word Document -- .doc and .docx
If oFile.Type Like "Microsoft Word*" Then
'Open the file
'.Path returns the full path of the file
Set oDoc = Documents.Open(fileName:=oFile.Path)
'Find all manual line breaks and replace them with paragraph markers
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
End With
oRng.Find.Execute Replace:=wdReplaceAll
fileName = oFso.GetBaseName(oFile.Name)
fileExtension = oFso.GetExtensionName(oFile.Name)
targetPath = oFso.BuildPath(targetFolder, fileName & "_Converted." & fileExtension)
'Save the changed document with the same name but appended with "_Converted" in your target folder
oDoc.SaveAs targetPath
'Close the original document without saving changes
oDoc.Close SaveChanges:=False
End If
Next
End Sub
Ссылки:
Время выполнения сценариев
Слово объектная модель