Private Sub Document_New()
Call Document_Open
End Sub

Private Sub Document_Open()
Application.ScreenUpdating = False
Dim Rng As Range, Str As String, Fld As Field, i As Long
i = CLng(InputBox("Which Office?" & vbCr & "1: Gothenburg, 2: Stockholm, 3: Malmö"))
If i = 0 Or i > 3 Then Exit Sub
With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)
Set Rng = .Range.Characters.First
Rng.Collapse wdCollapseStart
For Each Fld In .Range.Fields
With Fld
If .Type = wdFieldQuote Then
Set Rng = Fld.Result
.Delete
Exit For
End If
End With
Next
Select Case i
Case 1
Str = "Gothenburg AB, Tel 010-123456, www.gothenburg.com"
Case 2
Str = "Stockholm AB, Tel 010-123456, www.stockholm.com"
Case 3
Str = "Malmö AB, Tel 010-123456,www.malmö.com"
End Select
Set Fld = ActiveDocument.Fields.Add(Range:=Rng, Type:=wdFieldQuote, _
Text:="""" & Str & """", PreserveFormatting:=False)
End With
Set Fld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub