Подскажите, пожалуйста, что поправить чтобы макрос NonRecursiveMethod удалял метаданные в .docx файлах в выбранном каталоге и его подкаталогах с перезаписью файлов.
[vba]
Код
Public Sub NonRecursiveMethod() Dim fso, oFolder, oSubfolder, oFile, queue As Collection Dim wdDoc As Document
Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.GetFolder(GetFolder)
Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 'dequeue '...insert any folder processing code here...
For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder 'enqueue Next oSubfolder For Each oFile In oFolder.Files
'...insert any file processing code here... While oFile Like "*.docx" Set wdDoc = Documents.Open(FileName:=oFolder & "\" & oFile.Name, AddToRecentFiles:=False, Visible:=False) With wdDoc .RemoveDocumentInformation (wdRDIDocumentProperties) .Close SaveChanges:=True End With 'oFile = Dir() Wend
Next oFile Loop End Sub
[/vba]
Доброго времени суток,
Подскажите, пожалуйста, что поправить чтобы макрос NonRecursiveMethod удалял метаданные в .docx файлах в выбранном каталоге и его подкаталогах с перезаписью файлов.
[vba]
Код
Public Sub NonRecursiveMethod() Dim fso, oFolder, oSubfolder, oFile, queue As Collection Dim wdDoc As Document
Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.GetFolder(GetFolder)
Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 'dequeue '...insert any folder processing code here...
For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder 'enqueue Next oSubfolder For Each oFile In oFolder.Files
'...insert any file processing code here... While oFile Like "*.docx" Set wdDoc = Documents.Open(FileName:=oFolder & "\" & oFile.Name, AddToRecentFiles:=False, Visible:=False) With wdDoc .RemoveDocumentInformation (wdRDIDocumentProperties) .Close SaveChanges:=True End With 'oFile = Dir() Wend