change name of CustomDocumentProperties in word with vba - vba

Question

How can I rename my customVariable in word? I have a Customvaraiable called "Document Number", but I would now like to rename it to _DocumentNumber"
I know I can create a new CustomVariable, delete the old one, but I am then struggling with how to update all the links in the document to the new one.
Edited code:
Sub test()
Dim A As word.Field
Dim FldUpd As String
Dim findText As String
Dim replaceText As String
findText = "Document Number"
replaceText = "_DocumentNumber"
ActiveWindow.View.ShowFieldCodes = False
If ActiveDocument.CustomDocumentProperties(findText).value = "" Then Exit Sub
For Each A In ActiveDocument.Fields
If A.result.Text = ActiveDocument.CustomDocumentProperties(findText).value Then
Call WordProperties.createCustomDocumentProperty(ActiveDocument.name, replaceText, ActiveDocument.CustomDocumentProperties(findText).value)
ActiveWindow.View.ShowFieldCodes = True
A.Select
'DOCPROPERTY "Document number" \* MERGEFORMAT
With Selection.Find
.Text = "DOCPROPERTY*" & findText
.Replacement.Text = "DOCPROPERTY " & replaceText
.Format = True
.MatchCase = False
.MatchWildcards = True
End With
tempBool = Selection.Find.Execute(replace:=wdReplaceAll)
' Refresh fields
ActiveDocument.Fields.update
ActiveWindow.View.ShowFieldCodes = False
If tempBool Then ActiveDocument.CustomDocumentProperties(findText).Delete
End If
Next
End Sub
Edited:
The problem is that the find method does not return true.

Answer 1

You are mixing up two things that must be separate.
First create the new doc property, using ActiveDocument.CustomDocumentProperties.Add
You do this only once, since the doc property exists only once.
Then you replace all existing references to the old doc property to the new one. Something like (excerpts from macro recorder)
' Show field source references (Alt+F9) so you can use Find&Replace
ActiveWindow.View.ShowFieldCodes = True
With Selection.Find
.Text = "DOCPROPERTY Document Number"
.Replacement.Text = "DOCPROPERTY _DocumentNumber"
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' Refresh fields
ActiveDocument.Fields.Update
ActiveWindow.View.ShowFieldCodes = False
Then you can delete the old doc property.
Edit: to find and replace in all sections (including header & footer), see
Searching for Text in Header Section of A Word Document

Answer 2

Here is the working code, feel free to improve it:
Sub test()
Dim findText As String
Dim replaceText As String
Dim temp As Variant
findText = "Document Number"
replaceText = "_DocumentNumber"
On Error GoTo doesNotExist
temp = ActiveDocument.CustomDocumentProperties(findText).value
pFindTxt = "DOCPROPERTY*" & findText
pReplaceTxt = "DOCPROPERTY """ & replaceText
ActiveWindow.View.ShowFieldCodes = True
'create the new variable
Call WordProperties.createCustomDocumentProperty(ActiveDocument.name, replaceText, ActiveDocument.CustomDocumentProperties(findText).value)
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case rngStory.StoryType
Case WdStoryType.wdEvenPagesHeaderStory, _
WdStoryType.wdPrimaryHeaderStory, _
WdStoryType.wdEvenPagesFooterStory, _
WdStoryType.wdPrimaryFooterStory, _
WdStoryType.wdFirstPageHeaderStory, _
WdStoryType.wdFirstPageFooterStory
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
SearchAndReplaceInStory oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
' Refresh fields
ActiveDocument.Fields.update
ActiveWindow.View.ShowFieldCodes = False
Exit Sub
doesNotExist:
MsgBox "CustomVariable " & findText & " does not exist"
Exit Sub
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As word.Range, ByVal strSearch As String, ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
.Execute replace:=wdReplaceAll
End With
End Sub