Доброго времени суток!
Прошу помочь с решением такой задачи:
1. Имеется порядка 500 файлов ".xsl" в различных каталогах и связанных между собой "в хаотическом порядке"
2. Необходимо сохраняя связи между этими файлами изменить их формат на ".xlsm"
Думаю использовать такой алгоритм:
1. Открыть одновременно все файлы (если хватит ресурсов компьютера)
2. Запустить процедуру пересохранения и закрытия этих файлов (см. ниже).
3. Проверка
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
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
Посмотрите, пожалуйста, правильно ли я модифицировал макрос, можно ли его улучшить, есть ли в нем явные ошибки.
P.S.
Т.к. файлы находятся в разных каталогах, то просто скопировать их на другой компьютер не получится - связи между файлами находящимися в разных каталогах будут прописаны полными путями. Как можно эту проблему обойти? Таким же образом: открыть все файлы и пересохранить их в новое место?
