Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удаление метаданных docx в подкаталогах - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Удаление метаданных docx в подкаталогах
user0 Дата: Воскресенье, 01.10.2017, 18:01 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
Доброго времени суток,

Подскажите, пожалуйста, что поправить чтобы макрос 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]
К сообщению приложен файл: ClearMetadata.docm (21.0 Kb)


Сообщение отредактировал user0 - Воскресенье, 01.10.2017, 18:28
 
Ответить
СообщениеДоброго времени суток,

Подскажите, пожалуйста, что поправить чтобы макрос 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]

Автор - user0
Дата добавления - 01.10.2017 в 18:01
user0 Дата: Понедельник, 02.10.2017, 14:07 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
Внезапно нашел ответ на свой вопрос парой постов ниже
 
Ответить
СообщениеВнезапно нашел ответ на свой вопрос парой постов ниже

Автор - user0
Дата добавления - 02.10.2017 в 14:07
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!