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