VBA: Cambiar propiedades de un documento de Word

Recientemente me percaté que en una carpeta de trabajo almacenaba multitud de ficheros de Word que he ido generando a lo largo de meses y que por la mecánica de creación (copiar y pegar), todos ellos tenían una propiedades de documento (Título, autor u Organización) idénticas.. y que no eran las que yo quería.

La idea es no tener que ir documento a documento desde las propiedades del documento (desde el Explorador de Windows) cambiando dichas propiedades... así pues, veamos como una macro desde Excel nos ayudará a esto.

Insertamos un módulo estándar, y en esta ventana de código añadiremos nuestra macro:

Sub Cambiar_Autor_Organizacion_Titulo()
'Modificaremos las propiedades de los documentos de Word
'en concreto el Autor, Organización y el Título.

'definimos las variables para Word
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.application")

Dim Autor As String
Dim sFolder As String
'Abre la aplicación para seleccionar la carpeta
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then 'si presionamos Aceptar
        sFolder = .SelectedItems(1)
    End If
End With
'control para verificar que hemos selecccionado alguna carpeta
If sFolder = "" Then Exit Sub

'trabajamos sobre los ficheros de Word (.docx) de la carpeta
Dim strFileSpec As String, strFilename As String
strFileSpec = sFolder & "\" & "*.docx"
strFilename = Dir(strFileSpec)

'recorremos la carpeta buscando ficheros
Do While Len(strFilename) > 0
    'mientras haya fichero recuperamos el nombre del fichero
    'para convertirlo en su Título
    Titulo = Split(strFilename, ".")(0)
    'abrimos el documento de Word
    Set wdDoc = wdApp.documents.Open(sFolder & "\" & strFilename)
    
    'y cambiamos las propiedades.
    With wdDoc
        .BuiltinDocumentProperties("Author") = "excelforo.com"
        .BuiltinDocumentProperties("Title") = Titulo
        .BuiltinDocumentProperties("Company") = "EXCELFORO"
        .Saved = False
        .Save   'grabamos el cambio
        .Close  'cerramos el documento
    End With
    
    strFilename = Dir
Loop
'cerramos la aplicación de Word
wdApp.Quit

'y liberamos memoria
Set wdDoc = Nothing
Set wdApp = Nothing

MsgBox ("Finalizado!")
End Sub

tras ejecutar la macro vemos el efecto...