Sub WORD_HIPER_LINK()
Dim wordApp As Object
Dim strFullFileName$
'для отладки, потом убрать
strFullFileName = "C:\2.xls"
'On Error Resume Next
'создаем word
Set wordApp = CreateObject("Word.Application")
Application.FollowHyperlink strFullFileName
wordApp.Quit
Set wordApp = Nothing
End Sub

Dim PID&
PID = GetCurrentProcessId

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public PID_OPEN_FILE_1
Public strFullFileName$



Sub АКТИВИРУЕМ_ОКНО_СОСЕДНЕГО_ПРИЛОЖЕНИЯ_EXCEL_И_ОТКРЫВАЕМ_ФАЙЛ_В_НЕМ()

Dim WMI
Dim Process
Dim SQuery
Dim WShell  '
Dim Processes 'Коллекция процессов
Dim Ret
Dim PID
'On Error Resume Next
strFullFileName = "C:\1.xls"
'  //Соединяемся с WMI
If PID_OPEN_FILE_1 = Empty Then
MsgBox "попыток открытия файла с помощью данного макроса еще небыло"
Else
MsgBox "файл уже открывали"
End If
 
Set WShell = CreateObject("Wscript.Shell")
Set WMI = GetObject("winMgmts:")
  PID = GetCurrentProcessId
        'Формируем текст запроса
        SQuery = "SELECT * FROM Win32_Process  WHERE Name<>'EXPLORER.EXE'"
        'Создаем коллекцию-результат запроса
        Set Processes = WMI.ExecQuery(SQuery)
        'Цикл по всем элементам коллекции
For Each Process In Processes
 Ret = False
 If Process.Caption Like "EXCEL.EXE" And Process.processid <> PID Then
   Select Case PID_OPEN_FILE_1
   Case Empty
   '''для контроля записываем id-процесса, в котором открыли файл.
   '''при последующем открытии файла будем перебирать все id-процесса - пока не найдем нужный
     PID_OPEN_FILE_1 = Process.processid
       Ret = WShell.AppActivate(Process.processid)
         If Ret = True Then Ret = ShellExecute(0, "open", strFullFileName, 0, vbNullString, 5)
   Case Process.processid
      Ret = WShell.AppActivate(Process.processid)
           If Ret = True Then Ret = ShellExecute(0, "open", strFullFileName, 0, vbNullString, 5)
   End Select
 End If
Next
Set WMI = Nothing
Set WShell = Nothing
End Sub