Option Explicit
 
Private Sub Document_New()
Call Document_Open
End Sub
 
Private Sub Document_Open()
  If MsgBox("Go to Footer?", vbYesNo, "Destination Selector") = vbYes Then
    ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryFooter
  End If
End Sub

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