Sub OpenWord()
Dim OutFileName As String
Dim strForWho As String
Dim wbApp As Object


Set wbApp = CreateObject("Word.Application")
Set wbApp = GetObject(, "Word.Application")
wbApp.Documents.Open ("C:\Test.doc")
wbApp.Visible = True

strForWho = Range("A1").Value 
OutFileName = ThisWorkbook.Path & "\" & strForWho & ".doc"
With wbApp
.ActiveDocument.SaveAs Filename:=OutFileName
End With
''''''''''''''''''''''''разрываем связи
With wbApp

ПРОЦЕДУРА РАЗРЫВАНИЯ СВЯЗЕЙ

End With
'''''''''''''''''''''''''''''''''''''''''

wbApp.Quit
Set wbApp = Nothing



End Sub