Наверняка многие сталкивались с такой проблемой, что некоторые программы и макросы позволяют работать исключительно с определенными форматами файлов. А в жизни далеко не всегда все файлы в одном формате. Например, модная в последнее время надстройка PowerQuery неравнодушна к файлам xlsb - с ними она порой отказывается нормально работать и предпочитает им более открытые форматы xlsx и xslm.
Решил набросать небольшой практический код, который пересохраняет все файлы в указанной папке в один формат, что избавит от ручной работы в виде открывания и сохранения каждого файла в нужный формат.
'--------------------------------------------------------------------------------------- ' Author : The_Prist(Щербаков Дмитрий) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' http://www.excel-vba.ru ' Purpose: '--------------------------------------------------------------------------------------- Option Explicit Sub SaveAs_Mass() Dim sFolder As String, sFiles As String, sNonEx As String, sNewEx As String Dim wb As Workbook Dim lPos As Long, lFileFormat As Long, IsDelOriginal As Boolean 'указываем новый формат файлов sNewEx = InputBox("Укажите новое расширение для файлов:", "www.excel-vba.ru", "xlsx") 'определяем числовой код формата файлов Select Case sNewEx Case "xlt": lFileFormat = 17 Case "xla": lFileFormat = 18 Case "xlsb": lFileFormat = 50 Case "xlsx": lFileFormat = 51 Case "xlsm": lFileFormat = 52 Case "xltm": lFileFormat = 53 Case "xltx": lFileFormat = 54 Case "xlam": lFileFormat = 55 Case "xls": lFileFormat = 56 'если указанный формат не соответсвует ни одному из существующих Case Else MsgBox "Формат '" & sNewEx & "' не поддерживается", vbCritical, "www.excel-vba.ru" Exit Sub End Select ' если надо просматривать файлы в той же папке, что и файл с кодом: ' sFolder = ThisWorkbook.Path 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) 'запрашиваем - удалять ли исходные файлы после сохранения в новом формате IsDelOriginal = MsgBox("Удалять исходные файлы после пересохранения?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes 'отключаем обновление экрана и показ системных сообщений Application.ScreenUpdating = 0 Application.DisplayAlerts = 0 'просматриваем все файлы Excel в выбранной папке sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" If sFiles <> ThisWorkbook.Name Then 'получаем имя файла без расширения lPos = InStrRev(sFiles, ".") sNonEx = Mid(sFiles, 1, lPos) 'открываем книгу Set wb = Application.Workbooks.Open(sFolder & sFiles, False) 'сохраняем в новом формате и закрываем wb.SaveAs sFolder & sNonEx & sNewEx, lFileFormat wb.Close 0 DoEvents 'если надо удалить исходные файлы после преобразования If IsDelOriginal Then On Error Resume Next Kill sFolder & sFiles DoEvents On Error GoTo 0 End If End If sFiles = Dir Loop 'возвращаем обновление экрана и показ системных сообщений Application.ScreenUpdating = 1 Application.DisplayAlerts = 1 MsgBox "Файлы преобразованы", vbInformation, "www.excel-vba.ru" End Sub |
Все, что будет необходимо это указать один из форматов и выбрать папку с файлами, для пересохранения. В папке может находится и сам файл с кодом, но он не будет затронут.
Основные запросы и настройки кода:
- Первым появляется запрос формата файлов(
Укажите новое расширение для файлов: ) - здесь надо указать формат, который будет назначен выбранным файлам после выполнения команды. Доступные форматы:-
1. xlsx - книга Excel без поддержки макросов. При сохранении в данный формат книг, содержащих макросы, все макросы будут удалены автоматически. Если необходимо сохранить макросы следует выбрать формат - xlsm.
2. xlsm - книга Excel с поддержкой макросов
3. xlsb - двоичная книга Excel (с поддержкой макросов)
4. xlam - надстройка Excel (с поддержкой макросов)
5. xltx - шаблон Excel (без поддержки макросов)
6. xltm - шаблон Excel с поддержкой макросов
7. xls - книга Excel (97-2003)
8. xla - надстройка Excel (97-2003)
9. xlt - шаблон Excel (97-2003)Все форматы стандартны для Excel. В случае указания формата, который отсутствует в перечисленном списке, появится сообщение, что такой формат не поддерживается и код не будет выполнен.
- Далее появляется запрос указать папку с файлами, которые надо пересохранить.
- И последний запрос - "Удалять исходные файлы после пересохранения?". Если выбрать да, то после сохранения каждого файла в папке в нужный формат его исходник будет удален. Следует осторожно использовать эту опцию, т.к. удаление файлов происходит без возможности восстановления. Особенно это критично, если пересохранение идет либо в формат xslx, при котором удаляются все макросы из файла, либо при сохранении в устаревший формат xls, который поддерживает не более 65536 строк данных и 256 столбцов. Если какие-то файлы при этом ранее были в более новом формате и содержали большее количество строк или столбцов, то данные будут утеряны(сохранится только 65536 строк и 256 столбцов).
Изменение формата приведенным кодом возможно только для файлов Excel и не может быть использовано для изменения форматов файлов других программ(OpenOffice, Paint и т.п.).
Сменить формат файлов.xslm (29,8 КиБ, 1 234 скачиваний)
Так же см.:
Просмотреть все файлы в папке
Как удалить макросы в книге?
Сменить формат файлов
Отлично!Будет очень круто, если можно сделать так, чтобы не писать формат вручную, а выбрать(из выпадающего списка).
это усложнит код, т.к. надо будет создавать дополнительно форму пользователя и из неё выполнять часть действий.
уважаемый Дмитрий, здравствуйте!
я заметил что если нужно менять формат с xlam на xlsx то формат не меняется.
для этого нужно менять строку
sFiles = Dir(sFolder & "*.xls*")
на
sFiles = Dir(sFolder & "*.xl*")
Подскажите, как сделать так, чтобы подпапки тоже затрагивало? Спасибо.
Олег, только если совместить с кодом из этой статьи:Просмотреть все файлы в папке
Большое спасибо за код!
Подскажите, можно ли добавить к названию пересоханенных файлов текущую дату?
Подойдет ли такой вариант, и куда его вставить?
r = Format(Now(), "yymmdd")
имя файла -> " & r & "_продажи"
Ирина, в коде вроде все важные строки прокомментированы :) Находите эти строки:
'сохраняем в новом формате и закрываем
'сохраняем в новом формате и закрываем
wb.SaveAs sFolder & sNonEx & sNewEx, lFileFormat
и меняете соответственно имя:
r = Format(Now(), "yymmdd")
wb.SaveAs sFolder & sNonEx & r & "_продажи" & sNewEx, lFileFormat
Дмитрий, здравствуйте,
попробовал Ваш код для преобразование файла формата csv в xlsx.
В исходном файле много строк. В каждой строке значения разделены ;
В полученном файл все значения каждой строки получились записанными не в несколько ячеек, а в одну в столбце А.
Что можно сделать?
Спасибо.
Дмитрий, так в статье про CSV речи не идет - там про файлы Excel. А CSV это по сути текстовый файл и открытие иначе должно происходить - через OpenText. В котором есть параметр Local и его надо установить в True. Тогда, возможно, открывать файл будет с корректными разделителями и как следствие сохранять правильно. Запишите макрорекордером открытие файла CSV и для параметра Local задайте True.
Плюс непонятно про "много строк разделены ;" - может столбцы, а не строки? :)
Добрый день, сделал все согласно инструкции, макрос отработал и написал файлы преобразованы, но по факту все файлы с макросами остались с макросами
Ксения, очень мало информации для того, чтобы дать хоть сколь-нибудь вменяемый ответ. Нет данных ни о том какие изначально файлы находятся в папке, ни в какие указываете преобразовать.