Adding a Field to Word Document

[KjBox]

I have the below codes.



There is 1 other procedure which updates the workbook then calls "GetWordFile" then calls "PopulteWord"

Sub GetWordFile()
    Dim oWd As Object, oDoc As Object, f As Boolean
    
    sfile = Application.GetOpenFilename( _
        FileFilter:="Word Files *.doc* (*.doc*),", _
        Title:="Browse to and open required word file.", _
        MultiSelect:=False)
    If sfile <> "False" Then
        On Error Resume Next
        Set oDoc = GetObject(sfile)
        On Error GoTo 0
        If oDoc Is Nothing Then
            Set oWd = GetObject(, "Word.Application")
            If oWd Is Nothing Then
                Set oWd = CreateObject("Word.Application")
                If oWd Is Nothing Then
                    MsgBox "Failed to start Word!", 16, "Word File Selection"
                    Exit Sub
                End If
                f = True
            End If
            Set oDoc = oWd.Documents.Open(sfile)
            If oDoc Is Nothing Then
                MsgBox "Failed to open selected document!", 16, "Word File Selection"
                If f Then
                    oWd.Quit
                End If
                Exit Sub
            End If
            oWd.Visible = True
        Else
            With oDoc.Parent
                .Visible = True
            End With
        End If
    Else
        Application.DisplayAlerts = 0
        MsgBox "No file selected.", 16, "Word File Selection"
        Application.DisplayAlerts = 1
    End If
End Sub

Sub PopulateWord()
    Dim x, y, i As Long, oDoc As Object, sKap As String, sFldText As String
    Set oDoc = GetObject(sfile)
    
    x = [tblMergefields]
    
    With oDoc
        .Bookmarks("Start").Range.Select
        .Activate
        With .Parent.Selection
            i = i + 1
            GetTextAndStyle CStr(x(i, 20))
            sFldText = "MERGEFIELD  " & x(i, 6) & " "
            .TypeText Text:=x(i, 20) & " " & sText
            .Style = oDoc.Styles(sStyle)
            .TypeParagraph
            .Fields.Add .Range, wdFieldEmpty, sFl, 1
            .Style = oDoc.Styles("Normal")
            .TypeParagraph
            i = i + 1
            GetTextAndStyle CStr(x(i, 20))
            .TypeText Text:=x(i, 20) & " " & sText
            .Style = .Parent.Styles(sStyle)
            .TypeParagraph
               ' further code that is a repeat of above to add further headings and fields
        End with
    End with

End Sub

Sub GetTextAndStyle(s As String)
    Dim x, i As Integer
    
    x = [tblKapitel]
    For i = 1 To UBound(x, 1)
        If x(i, 1) = s Then
            sText = x(i, 2)
            sStyle = UCase(x(i, 4))
            Exit For
        End If
    Next
    If i = UBound(x, 1) + 1 Then
        sText = x(i, 2)
        sStyle = "Normal"
    End If
    
End Sub

The word document that is selected will always be empty but with preset Styles and a single bookmark to set the starting point for the required data to be added.

All works fine until the line

.Fields.Add .Range, wdFieldEmpty, sFl, 1

Then I get Error 4608 "Value out of range"

Recording a macro directly in the opened document to add the field gives

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "MERGEFIELD  F111 ", PreserveFormatting:=True

The value in x(i, 6) is "F111" and the variable sFldText returns the correct Text.

The cursor in the word document moves to a new paragraph correctly and is in the correct position to add the Field.

I have tried countless ways to get around this error but can't figure it out, any help or suggestions greatly appreciated.

TIA.

[KjBox]

I see this thread has been moved from Excel Programming to Word VBA.

The code is actually being run from an Excel file.

[macropod]

You're passing a variable named 'sFl' in:
.Fields.Add .Range, wdFieldEmpty, sFl, 1
but no such variable exists anywhere else in the code you've posted.

[KjBox]

That was a typo on my part, initially I did not use a variable, then tried using a variable to get rid of the error. At first I named the variable sFl then later changed it to sFldText but forgot to change it in that line of code.

Changing sFl to sFldText still gives the same Run time error 4608

[KjBox]

I just tried adding a new bookmark to the document and using

oDoc.bookmarks("H_Field").Range.Select
.Fields.Add oDoc.Parent.Selection.Range, wdFieldEmpty, sFldText, 1

The document cursor move to the correct bookmark, but the 4608 error remains.

[KjBox]

Even if adding bookmarks to the blank document did work I could not use it because there can be multiple Fields under most of the headings.

I am attaching the Excel file and a blank Word document (with the preset Styles) and a manually created document which shows the desired result after the blank document is populated.

CTRL+SHIFT+A from the Excel file is the shortcut to start the process.

Running the PopulateWord procedure with "On Error Resume Next" at the start results in all the headings being correct and the paragraphs between them for the Field(s) is correct, just no Fields!

Without "On Error Resume Next" the code errors on every ".Fields.Add......"

[macropod]

When I opened your Excel workbook and had a look at your code, what I found is that it doesn't have a reference to the Word object library. Without that, you can't use named constants like wdFieldEmpty.

I'd also have to question why you're approaching the project the way you are. It seems to be a very round-about way of creating a document. Since you'd need to know what the data source is in order to populate the mergefields after the mailmerge main document has been created, why not simply populate the document with the corresponding data instead of relying on a mailmerge to do so?

[KjBox]

Thanks for that, a case of not seeing the wood for the trees!

Adding the reference to Word Object Library, or changing wdFieldEmpty to its enumeration value of -1, and all is good.