Открытие Word из Excel и Поверх всех окон

Sub za()
    Dim objWrdApp As Object
    Dim objWrdDoc As Object
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
            Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path + "" + "t.dot")
            objWrdApp.Visible = True
        End If
    Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path + "" + "t.dot")
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    
End Sub

SetAttr zname, vbNormal
objWrdDoco.SaveAs zname
 objWrdApp.Quit True
 SetAttr zname, vbReadOnly

ActiveDocument.Protect Password:="abc", NoReset:=False, Type:= _
wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
' Далее идёт сохранение
ChangeFileOpenDirectory "C:\tdoc"
ActiveDocument.SaveAs FileName:="Doc1.docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=True, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

zpath = ThisWorkbook.Path + "\"
zdot = zpath & "prikaz.docx"
zname = zpath & "www1.doc"
Shell "winword.exe " & zname, vbMaximizedFocus

Shell "winword.exe """ & zname & """", vbMaximizedFocus

strFile=dir("C:\*.txt")
do
strFile=dir()
loop until(strFile="")

Sub main()
    ' Исходное имя файла без расширения:
    Const cstrF As String = "file"
    Dim i As Integer
    Dim strFile As String
    
    ' Проверяем исходное имя. App.Path - это свойство для получения пути к исполняемому файлу в Visual Basic 
    ' (в VBA этого нет. Т.к. у вас пишет без проблем, то его нужно убрать).
    strFile = Dir(App.Path & "\" & cstrF & ".txt")
    If (Len(strFile) > 0) Then
        ' Если существует:
        i = 0
        Do
            i = i + 1
            ' Перебираем файлы file(1).txt, file(2).txt и т.д. до тех пор, пока файл не будет найден 
            ' (т.е. выходим из цикла, когда файл не найден)
            strFile = Dir(App.Path & "\" & cstrF & "(" & CStr(i) & ").txt")
        Loop Until (Len(strFile) = 0)
        ' Запоминаем не найденный файл.
        strFile = App.Path & "\" & cstrF & "(" & CStr(i) & ").txt"
    Else
        ' Если файл не найден, запоминаем его название.
        strFile = App.Path & "\" & cstrF & ".txt"
    End If
    'Записываем какой-нибудь содержимое в файл
    Open strFile For Output As #1
    Print #1, "abc"
    Close #1
End Sub