1

Тема: Изменить свойства сразу нескольким документам

Добрый день! В папке лежит несколько word файлов. Как сразу всем файлам изменить свойства (это те, что при открытии документа на главной странице во Сведениях): название, ключевые слова, примечания, тема и т.д? Для всех файлов значения свойств одинаковые.

2

Re: Изменить свойства сразу нескольким документам

Route пишет:

Добрый день! В папке лежит несколько word файлов. Как сразу всем файлам изменить свойства (это те, что при открытии документа на главной странице во Сведениях): название, ключевые слова, примечания, тема и т.д? Для всех файлов значения свойств одинаковые.

Макрососом нужно. Примерно так:

Sub Макрос10Свойства()
'
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
Dim sTitle, sKeyword As String
'вводите параметры для свойств
sTitle = InputBox("Введите значение для заголовка")
sKeyword = InputBox("Введите значение для ключевых слов")
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        Set oDoc = Word.Documents.Open(sFullName, )
        For Each oProp In oDoc.BuiltInDocumentProperties
            'Так можно узнать имя свойства и его значения
            MsgBox oProp.Name & vbCr & oProp.Value
            'Можно установить нужное значение
            oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
            oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
'Примеры имён свойств
'wdPropertyAppName
'wdPropertyAuthor
'wdPropertyBytes
'wdPropertyCategory
'wdPropertyCharacters
'wdPropertyCharsWSpaces
'wdPropertyComments
'wdPropertyCompany
'wdPropertyFormat
'wdPropertyHiddenSlides
'wdPropertyHyperlinkBase
'wdPropertyKeywords
'wdPropertyLastAuthor
'wdPropertyLines
'wdPropertyManager
'wdPropertyMMClips
'wdPropertyNotes
'wdPropertyPages
'wdPropertyParas
'wdPropertyRevision
'wdPropertySecurity
'wdPropertySlides
'wdPropertySubject
'wdPropertyTemplate
'wdPropertyTimeCreated
'wdPropertyTimeLastPrinted
'wdPropertyTimeLastSaved
'wdPropertyTitle
'wdPropertyVBATotalEdit
'wdPropertyWords
        Next oProp
    End If
    oDoc.Save
    
Next oFile
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

3

Re: Изменить свойства сразу нескольким документам

Доброй ночи! Совсем не было времени, вернулся вновь к этому вопросу, макрос ругается на строку:
Set oDoc = Word.Documents.Open(sFullName, )
sad

4

Re: Изменить свойства сразу нескольким документам

Убрал там запятую, запустилось, но теперь после того, как выбрал папку, выдает ошибку и ругается на строку:
oDoc.Save

5

Re: Изменить свойства сразу нескольким документам

Route пишет:

Убрал там запятую, запустилось, но теперь после того, как выбрал папку, выдает ошибку и ругается на строку:
oDoc.Save

А, да, немного не доработал. Запятую оставлял из-за того, что не знал, хотите ли вы видеть документ (хотя по сути он ненадолго открывается и возможность его пролистать вы не получите, поскольку диалоговые окна не с теми параметрами модальности). Вот так будет работать.

Sub СвойстваДокументов_ФСО()
'
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
Dim sTitle, sKeyword As String
'вводите параметры для свойств
sTitle = InputBox("Введите значение для заголовка")
sKeyword = InputBox("Введите значение для ключевых слов")
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        'Если хотите видеть документы, то оставляем без Visible = False
        Set oDoc = Word.Documents.Open(FileName:=sFullName, Visible:=False)
        For Each oProp In oDoc.BuiltInDocumentProperties
            'Так можно узнать имя свойства и его значения
            MsgBox oProp.Name & vbCr & oProp.Value
'Примеры имён свойств
'wdPropertyAppName
'wdPropertyAuthor
'wdPropertyBytes
'wdPropertyCategory
'wdPropertyCharacters
'wdPropertyCharsWSpaces
'wdPropertyComments
'wdPropertyCompany
'wdPropertyFormat
'wdPropertyHiddenSlides
'wdPropertyHyperlinkBase
'wdPropertyKeywords
'wdPropertyLastAuthor
'wdPropertyLines
'wdPropertyManager
'wdPropertyMMClips
'wdPropertyNotes
'wdPropertyPages
'wdPropertyParas
'wdPropertyRevision
'wdPropertySecurity
'wdPropertySlides
'wdPropertySubject
'wdPropertyTemplate
'wdPropertyTimeCreated
'wdPropertyTimeLastPrinted
'wdPropertyTimeLastSaved
'wdPropertyTitle
'wdPropertyVBATotalEdit
'wdPropertyWords
        Next oProp
        'Можно установить нужное значение
        oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
        oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
    End If
    oDoc.Save
    oDoc.Close
    'А можно просто "oDoc.Close SaveChanges:=wdSaveChanges"
Next oFile
End Sub

И вовсе не обязательно оставлять кусок с перебором каждого свойства - этот участок для того, чтобы вы могли их просмотреть для себя, а затем добавить строки для ввода нужных вам свойств документа. + если какие-то свойства постоянны, то их легче сразу задать текстом, чтобы каждый раз не вводить, например, имя пользователя постоянно "Андрей", тогда вы задаёте для свойства документа сразу Андрей, без InputBox-а. И сохранение забыл добавить.


Sub СвойстваДокументов_ФСО()
'
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
Dim sTitle, sKeyword As String
'вводите параметры для свойств
'по аналогии добавляем либо инпут боксы для других переменных, либо сразу задаём
'значение переменной, например sAuthor = "Андрей", либо сразу в свойстве указываем
'текст, чтобы избежать лишних переменных
'oDoc.BuiltInDocumentProperties(wdPropertyTitle) = "Андрей"
sTitle = InputBox("Введите значение для заголовка")
sKeyword = InputBox("Введите значение для ключевых слов")
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        'Если хотите видеть документы, то оставляем без Visible = False
        Set oDoc = Word.Documents.Open(FileName:=sFullName, Visible:=False)
        'Можно установить нужное значение
        'Сюда же добавляем аналогичные строки для других свойств
        oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
        oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
    End If
    oDoc.Save
    oDoc.Close
    'А можно просто "oDoc.Close SaveChanges:=wdSaveChanges"
Next oFile
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

6

Re: Изменить свойства сразу нескольким документам

Ещё можно взять вариант, когда все свойства будут браться из уже готового дока, который открыт на данный момент. Тогда просто переменные задаём не сами, а указываем, что они равны свойствам текущего документа. + не учитывал в приведённых примерах кода вариант, когда файлы из папки запущены. Вот тут добавил.

Sub СвойстваДокументов_ФСО()
'
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
Dim sTitle, sKeyword As String
'вводите параметры для свойств
sTitle = InputBox("Введите значение для заголовка")
sKeyword = InputBox("Введите значение для ключевых слов")
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        'MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        If InStr(sFullName, Chr(126) & Chr(36)) < 1 Then
        'Если хотите видеть документы, то оставляем без Visible = False
            Set oDoc = Word.Documents.Open(FileName:=sFullName, Visible:=False)
            'Можно установить нужное значение
            oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
            oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
            oDoc.Save
            oDoc.Close
        End If
    End If
    'А можно просто "oDoc.Close SaveChanges:=wdSaveChanges"
Next oFile
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

7

Re: Изменить свойства сразу нескольким документам

Огромное спасибо! Что-то начинает получаться, последняя идея мне понравилась больше всего, но не совсем понял чем последний код отличается от предпоследнего?!
Но я точно осознал, как хотелось бы. В идеале сделать так:
1. Открыл документ.
2. Запустил макрос.
3. Появилось окно "введите заголовок", при этом в поле уже введен тот заготовок, который присвоен документу. Т.е. я либо просто жму далее (если все меня устраивает), либо вношу изменение. И так далее по всем нужным мне свойствам (заголовок; ключевые слова; тема; дата публикации и другие уже добавлю сам...).
4. После указываю папку и жму ОК. Эти свойства присваиваются всем файлам в этой папке и все отлично! Сам открытый документ пусть остается открытым. Можно сделать в конце табличку: поля все документов обновлены!
Поможете еще чуть-чуть?  smile

8

Re: Изменить свойства сразу нескольким документам

Можно сделать в конце табличку: поля все документов обновлены!

не табличку, а сообщение такое, ну Вы поняли smile Что мол все сделано.

9

Re: Изменить свойства сразу нескольким документам

Route пишет:

Огромное спасибо! Что-то начинает получаться, последняя идея мне понравилась больше всего, но не совсем понял чем последний код отличается от предпоследнего?!

Разница довольно существенная. Вы говорили о том, чтобы всем файлам одни и те же значения свойства назначать. В этом случае лучше сразу задать значения свойств, которые хотите установить. Да и вообще... смысл при таком условии вам просматривать, какое значение свойства было? Макрос быстро пробежался бы и установил всем одинаковые, но если хотите всё сами просматривать, то можно и так. Дальше можно по аналогии

Sub СвойстваДокументов_ФСО()
'
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
'вводите параметры для свойств
'СЮДА МОЖНО ВЕРНУТЬ ИНПУТ БОКСЫ СВОЙСТВ<<<<
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        'MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        If InStr(sFullName, Chr(126) & Chr(36)) < 1 Then
        'Если хотите видеть документы, то оставляем без Visible = False
            Set oDoc = Word.Documents.Open(FileName:=sFullName, Visible:=False)
            MsgBox "Работаем с файлом: " & oDoc.Name
            'Вот такой код должен быть для каждого свойства:
            'Для заголовка
            Select Case MsgBox("Заголовок: " & oDoc.BuiltInDocumentProperties(wdPropertyTitle) & vbCr & "Меняем?", vbYesNo)
                Case vbYes: oDoc.BuiltInDocumentProperties(wdPropertyTitle) = InputBox("Введите значение для заголовка")
                Case vbNo:
            End Select
            'Такой для ключевых слово
            Select Case MsgBox("Ключевые слова: " & oDoc.BuiltInDocumentProperties(wdPropertyKeywords) & vbCr & "Меняем?", vbYesNo)
                Case vbYes: oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = InputBox("Введите значение для ключевых слов")
                Case vbNo:
            End Select
            oDoc.Save
            oDoc.Close
        End If
    End If
    'А можно просто "oDoc.Close SaveChanges:=wdSaveChanges"
Next oFile
MsgBox "Документы закончились."
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

10

Re: Изменить свойства сразу нескольким документам

А если хотите только 1 раз ввести свойства и применить их для всех доков, но с редактированием, то так:

Sub СвойстваДокументов_ФСО()
' Изменение своств документов в папке по аналогии с первым
Dim oDoc As Document
Dim oFolder As Object
Dim objFSO As Object
Dim oFile As Object
Dim oProp As DocumentProperty
Dim sFullName, sFolder As String
Dim sTitle, sKeyword As String
Dim bChecked As Boolean
'вводите параметры для свойств
'<<<< СЮДА МОЖНО ВЕРНУТЬ ИНПУТ БОКСЫ СВОЙСТВ
'выбираете папку
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1) & Application.PathSeparator
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = objFSO.GetFolder(sFolder)
For Each oFile In oFolder.Files
    'берём все файлы ворда
    If InStr(oFile.Name, ".doc") >= 1 Or InStr(oFile.Name, ".docx") >= 1 Or InStr(oFile.Name, ".docm") >= 1 Then
        'MsgBox oFile.Name & vbCr & oFile.Path
        sFullName = oFile.Path
        If InStr(sFullName, Chr(126) & Chr(36)) < 1 Then
        'Если хотите видеть документы, то оставляем без Visible = False
            Set oDoc = Word.Documents.Open(FileName:=sFullName, Visible:=False)
            If bChecked = False Then
                MsgBox "Работаем с файлом: " & oDoc.Name
                'Вот такой код должен быть для каждого свойства:
                'Для заголовка
                Select Case MsgBox("Заголовок: " & oDoc.BuiltInDocumentProperties(wdPropertyTitle) & vbCr & "Меняем?", vbYesNo)
                    Case vbYes: sTitle = InputBox("Введите значение для заголовка"): oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
                    Case vbNo: sTitle = oDoc.BuiltInDocumentProperties(wdPropertyTitle)
                End Select
                'Такой для ключевых слов
                Select Case MsgBox("Ключевые слова: " & oDoc.BuiltInDocumentProperties(wdPropertyKeywords) & vbCr & "Меняем?", vbYesNo)
                    Case vbYes: sKeyword = InputBox("Введите значение для ключевых слов"): oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
                    Case vbNo: sKeyword = oDoc.BuiltInDocumentProperties(wdPropertyKeywords)
                End Select
                '<<<< Сюда вставляем следующее свойство, перед bChecked = True
                bChecked = True
            Else
                '<<<< А сюда дублируем просто установку значения свойства
                oDoc.BuiltInDocumentProperties(wdPropertyTitle) = sTitle
                oDoc.BuiltInDocumentProperties(wdPropertyKeywords) = sKeyword
            End If
            oDoc.Save
            oDoc.Close
        End If
    End If
    'А можно просто "oDoc.Close SaveChanges:=wdSaveChanges"
Next oFile
Set objFSO = Nothing: Set oFolder = Nothing
MsgBox "Документы закончились."
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871