Export field constructions as text

I take no credit for this useful macro beyond making it available here.

Fellow Word MVP Cindy Meister lists the code featured on her web site, http://homepage.swissonline.ch/cindymeister/mergfaq.htm) which may be used to reproduce field constructions for use in (e.g) on line forums.

If you have ever tried to document a field construction to a text file, you will know that it is not possible and where complex field constructions are involved (like those of fellow MVP Paul Edstein who uses the pseudonym 'Macropod' in the Word forums, in his remarkable work on date calculations) attempting to reproduce them is a nightmare. This simple macro solution overcomes that.

Sub FieldCodeToString()
Dim Fieldstring As String

Dim NewString As String

Dim CurrChar As String
Dim CurrSetting As Boolean

Dim fcDisplay As Object
Dim MyData As DataObject

Dim X As Long
NewString = ""
Set fcDisplay = ActiveWindow.View
Application.ScreenUpdating = False
CurrSetting = fcDisplay.ShowFieldCodes
If CurrSetting <> True Then fcDisplay.ShowFieldCodes = True
Fieldstring = Selection.Text
For X = 1 To Len(Fieldstring)
    CurrChar = Mid(Fieldstring, X, 1)
    Select Case CurrChar
        Case Chr(19)
            CurrChar = "{"
        Case Chr(21)
            CurrChar = "}"
        Case Else
    End Select
    NewString = NewString + CurrChar
Next X
Set MyData = New DataObject
MyData.SetText NewString
MyData.PutInClipboard
fcDisplay.ShowFieldCodes = CurrSetting
End Sub

This copies a facsimile of the field layout to the clipboard, and which can be reproduced as plain text. The result from the above example is reproduced below:

Reversing the process

Sub FieldStringToCode()
' Based on a macro provided by Paul Edstein
' Converts "textual" field codes into real field codes
' To do the conversion, simply paste the "textual" field codes
' into your document, select them and run the macro.
Dim RngFld As Range
Dim RngTmp As Range
Dim oFld As Field
Dim StrTmp As String
Dim sUpdate As String
Dim bFldCodes As Boolean
Const Msg1 = "Select the text to convert and try again."
Const Msg2 = "There are no field strings in the selected range."
Const Msg3 = "Unmatched field brace pairs in the selected range."
Const Title1 = "Error!"
Const Title2 = "Update fields?"
Application.ScreenUpdating = False
bFldCodes = ActiveDocument.ActiveWindow.View.ShowFieldCodes
If Selection.Type <> wdSelectionNormal Then
    MsgBox Msg1, vbExclamation + vbOKOnly, Title1
    Exit Sub
End If
If InStr(1, Selection.Text, "{") = 0 Or _
    InStr(1, Selection.Text, "}") = 0 Then
    MsgBox Msg2, vbCritical + vbOKOnly, Title1
End If
If Len(Replace(Selection.Text, "{", vbNullString)) <> _
    Len(Replace(Selection.Text, "}", vbNullString)) Then
    MsgBox Msg3, vbCritical + vbOKOnly, Title1
    Exit Sub
End If
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Set RngFld = Selection.Range
With RngFld
    .End = .End + 1
    Do While InStr(1, .Text, "{") > 0
        Set RngTmp = ActiveDocument.Range(Start:=.Start + _
                                          InStr(.Text, "{") - 1, _
                                          End:=.Start + InStr(.Text, "}"))
        With RngTmp
            Do While Len(Replace(.Text, "{", vbNullString)) <> _
                Len(Replace(.Text, "}", vbNullString))
                .End = .End + 1

                If .Characters.Last.Text <> "}" Then .MoveEndUntil cset:="}", _
                Count:=Len(ActiveDocument.Range(.End, RngFld.End))
            Loop
            .Characters.First = vbNullString
            .Characters.Last = vbNullString
            StrTmp = .Text
            Set oFld = ActiveDocument.Fields.Add(Range:=RngTmp, _
                                                 Type:=wdFieldEmpty, _

                                                 Text:="", _
                                                 PreserveFormatting:=False)
            oFld.Code.Text = StrTmp
        End With
    Loop
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = bFldCodes
    .End = .End - 1

    If bFldCodes = False Then .Fields.ToggleShowCodes

    .Select

End With
Application.ScreenUpdating = True
sUpdate = MsgBox("Do you wish to update the fields?" & vbCr + vbCr & _
"Note that if the converted fields include ASK or FILLIN fields, " & _
"updating will force the prompt for input to those fields", vbYesNo, Title2)
If sUpdate = vbYes Then RngFld.Fields.Update
Set RngTmp = Nothing
Set RngFld = Nothing
Set oFld = Nothing
End Sub