Sub Сохранение_открытых_файлов_в_новом_формате()
'ИМЯ_И_ПОЛНОЕ_ИМЯ_ФАЙЛА_ОТКРЫТОГО_В_СОСЕДНЕМ_ПРИЛОЖЕНИИ_
'[msg=12526882]
'http://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=939662&msg=12526882

Dim xlApp As Excel.Application
Dim xlWb As Workbook
On Error Resume Next
      Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
      If xlApp Is Nothing Then
'MsgBox "Похоже что ни одного файла Excel не открыто"
Exit Sub
End If
    
'цикл пересохранения файлов
For Each xlWb In xlApp.Workbooks
                                 'MsgBox "Имя файла:" & xlWb.Name     MsgBox "Полное имя файла:" & xlWb.FullName     MsgBox "Новое имя файла:" & xlWb.FullName & "m"
If Right(xlWb.FullName, 4) = ".xls" Then
xlWb.SaveAs Filename:= _
        xlWb.FullName & "m", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Next xlWb

'цикл закрытия файлов
For Each xlWb In xlApp.Workbooks
    'MsgBox "Имя файла:" & xlWb.Name     MsgBox "Полное имя файла:" & xlWb.FullName     MsgBox "Новое имя файла:" & xlWb.FullName & "m"
If Right(xlWb.FullName, 5) = ".xlsm" Then
xlWb.Close True
End If
Next xlWb
Set xlApp = Nothing
End Sub

        Workbooks.Open (iFile), UpdateLinks:=1