Microsoft Office Forums - View Single Post - Add custom doc properties in "Doc properties control"

JLanger · 09-13-2017, 02:16 PM

I'm posting this for anyone looking for a solution to updating previously inserted Custom Document Properties (CDP's). My approach is for situations where you have a number of documents which all have the same CDP's and you want to update all of the documents at once with the new values.

For example, I administrate a number of training documents for a factory, and those documents all have references to the company supplying our chemicals, and references to the particular chemical names. I've inserted CDP's related to these inline within all the documents. So, when the company/chemicals change all I need to do is run this macro, give it the filepath for the documents, input the new values, and then all the documents will be updated.

This saves hours of work, depending on your situation.

I've left the variables with my original names, change them to suit your situation.

I've included quite a few comments, mainly for those not as familiar with VBA.

Copy/Paste into a new module in Normal

Code:

Sub company_and_details_update()
Dim file
Dim path As String


Dim filepath As Variant
filepath = InputBox("Please enter the filepath for the files you want to update.", "Input Filepath", "Copy filepath here...")
    
If filepath = "" Then
    macroended = MsgBox("Macro ended.", , "Notification")
    Exit Sub
Else
End If

'I have three different custom doc properties below, these names do not need to match the pre-existing custom doc property names, but mine do, mainly for my sanity
'add or remove these/change the text as desired

Dim companyname As Variant
companyname = InputBox("Please enter the new chemical supplier company name, or, if the company is not changing, type the current company name.", "New Chemical Supplier?", "Type name here...")

If companyname = "" Then
    macroended = MsgBox("Macro ended.", , "Notification")
    Exit Sub
Else
End If


Dim foamingchemicalname As Variant
foamingchemicalname = InputBox("Please enter the new foaming chemical name, or, if this is not changing, type the current name.", "New Foaming Chemical?", "Type name here...")

If foamingchemicalname = "" Then
    macroended = MsgBox("Macro ended.", , "Notification")
    Exit Sub
Else
End If


Dim sanitisingchemicalname As Variant
sanitisingchemicalname = InputBox("Please enter the new sanitising chemical name, or, if this is not changing, type the current name.", "New Sanitising Chemical?", "Type name here...")

If sanitisingchemicalname = "" Then
    macroended = MsgBox("Macro ended.", , "Notification")
    Exit Sub
Else
End If


' Path to your folder
path = filepath & "\"

'below code displays a message box with the filepath given earlier, remove "'" at start of line to enable
'checkpath = MsgBox(path, , "Check Path")

' Change this file extension to the type of file you are opening.
file = Dir(path & "*.docx")

Application.ScreenUpdating = False

    Do While file <> ""
        Documents.Open FileName:=path & file
            'add more lines if required
            ActiveDocument.CustomDocumentProperties("companyname").Value = companyname
            ActiveDocument.CustomDocumentProperties("foamingchemicalname").Value = foamingchemicalname
            ActiveDocument.CustomDocumentProperties("sanitisingchemicalname").Value = sanitisingchemicalname
        
            ActiveDocument.Fields.Update
    
        ActiveDocument.Saved = False
        ActiveDocument.Save
        ActiveDocument.Close
    
        ' set file to next in Dir
        file = Dir()

    Loop

Application.ScreenUpdating = True

MsgBox "The operation is complete."

End Sub