Здравствуйте уважаемые форумчане. Excel 2003. Пытаюсь адаптировать под свои нужды макрос:
Код
Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String
Dim wb As Workbook
Dim initialDisplayAlerts As Boolean
Pathname = "C:\Users\MiniPC10\Desktop\Сергей\xlsx_test\"
Filename = Dir(Pathname & "*.xlsx")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Filename:=Pathname & Filename, _
UpdateLinks:=False)
wb.CheckCompatibility = False
saveFileName = Replace(Filename, ".xlsx", ".xls")
wb.SaveAs Filename:=Pathname & saveFileName, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
wb.Close SaveChanges:=False
Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.DisplayAlerts = initialDisplayAlerts
End Sub
никак не могу понять почему файл при изменении расширения на .xls выглядит вот таким образом (как во вложении) От макроса хочу добиться: поиск в определённой папке файлов с расширением.xlsx и преобразовании их в .xls С удалением .xlsx
huchos, потестировал, у меня нормально сохраняет (я бы добавил Application.ScreenUpdating = False) P.S. Правда у вас нет в коде удаления XLSX, но это можно сделать через Kill
Код
Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String, wb As Workbook, OldFileName As String
Pathname = "C:\Users\MiniPC10\Desktop\Сергей\xlsx_test\"
'Pathname = "C:\test\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
OldFileName = Filename
Set wb = Workbooks.Open(Filename:=Pathname & Filename, UpdateLinks:=False)
wb.CheckCompatibility = False
saveFileName = Replace(Filename, ".xlsx", ".xls")
wb.SaveAs Filename:=Pathname & saveFileName, FileFormat:=xlExcel8, _
ReadOnlyRecommended:=False, CreateBackup:=False
wb.Close SaveChanges:=False
Kill Pathname & OldFileName
Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!", , ""
End Sub
написал: потестировал, у меня нормально сохраняет (я бы добавил Application.ScreenUpdating = False) P.S. Правда у вас нет в коде удаления XLSX, но это можно сделать через Kill
С удалением проблем не возникнет, а вот как это побороть. Может это быть за-за версии Excel?
huchos, А почему на вашей картинке открыт XLSX файл, а не новый XLS ? Вы пишите нам - я кодом пересохраняю файл в XLS, открываю его, а там у меня кракозябли, вот вам картинка. А мы открываем вашу картинку и видим, что вы открываете не XLS, a XLSX
написал: huchos, А почему на вашей картинке открыт XLSX файл, а не новый XLS ? Вы пишите нам - я кодом пересохраняю файл в XLS, открываю его, а там у меня кракозябли, вот вам картинка. А мы открываем вашу картинку и видим, что вы открываете не XLS, a XLSX
Да немного не правильно написал: при попытке пересохранения
Спасибо, всё это к сожалению не подойдёт, комп рабочий, всё заадминистрировано, ничего не дают делать. Пытаюсь как-то макросом выйти из положения. Приходится по файлу ПКМ-Сохранить как-Ок. Хотелось автоматизировать. Видно не судьба.