You are getting your range names and bookmark names mixed up and not achieving the intended aim. Use the following to fill the bookmarks
Code:
Public Sub FillBM(strBMName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = strValue
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub
and call it with
Code:
FillBM "bmContact", StrTextContact
FillBM "bmCompany", StrTxtCompany
etc
If the named bookmarks or the strings don't exist the function does nothing, otherwise the values are written into the named bookmarks, and are replaced if you run the calling macro again with different values.