Скрипт для экспресс-восстановления Excel-файлов после повреждения

    Данная заметка предназначен тем, у кого при попытке открыть Excel-файл выдается сообщение об ошибке вида:


    В моем случае с такой ошибкой открывался xlsx-файл (далее 1.xlsx), восстановленный с помощью R-Saver после вирусной атаки, подобной «Petya».

    После распаковки содержимого файла 1.xlsx в папку "\1" через контекстное меню были выданы следующие ошибки:


    Оказалось, что эти служебные файлы имеют нулевой размер. Я проделал аналогичную процедуру с исправным файлом 2.xlsx и скопировал из его папки "\2" ненулевые файлы [Content_Types].xml и .rels поверх пустых из "\1". Далее добавил содержимое папки "\1" в архив .zip и переименовал его в 3.xlsx. В результате, файл 3.xlsx уже открылся с корректными данными хотя и с предупреждением:


    Для автоматизации проделанных выше процедур был разработан скрипт vbscript, распространяемый «As Is».

    Исходный код скрипта ST1_XLSX_FIXER_v1
    option explicit
    
    Const THIS_SCRIPT_NAME = "ST1_XLSX_FIXER_v1.vbs"
    Const SUBDIR_XLS_SRC = "ST1_XLSX_FIXER_DATA_v1"
    Const SUBDIR_OUT = "ST1_XLSX_FIXED"
    Const RES_SUFFIX = "_fixed_ST1_v1"
    
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    
    'если запускаем скрипт автономно
    if WScript.ScriptName = THIS_SCRIPT_NAME then
        if WScript.Arguments.Count > 0  then		
            Dim fname
            for each fname in WScript.Arguments
    			if fso.GetExtensionName(fname) = "xls" then 
    				WScript.Echo "Файлы формата Excel 2003 и ранее (.xls) не поддерживаются"			
    			else
    				FixCorruptedExcel fname			
    			end if
    		next
        else
            WScript.Echo "Для работы перенесите выбранные xlsx-файлы на скрипт"
        end if         
    end if
    
    Set fso = Nothing
    
    Sub FixCorruptedExcel(fpath)
    	
    	Dim out_dir: out_dir = fso.GetParentFolderName(fpath) & "\" & SUBDIR_OUT
    	if Trim(out_dir) <> "" then
    		'создание папки результатов
    		If not fso.FolderExists(out_dir) Then
    			fso.CreateFolder(out_dir)
    		end if
    	End If
    
    	'cоздать копию xlsx-файла с расширением .zip
    	Dim extract_dir: extract_dir = out_dir & "\" & fso.GetBaseName(fpath)
    	Dim fpath_zip: fpath_zip = extract_dir & ".zip"
    
    	fso.CopyFile fpath, fpath_zip
    
    	'выходной файл
    	Dim fpath_fixed: fpath_fixed = extract_dir & RES_SUFFIX & ".xlsx"
    	if fso.FileExists(fpath_fixed) then fso.DeleteFile fpath_fixed 
    	
    	'распаковка zip
    	UnzipFile fpath_zip, extract_dir
    	
    	'удаление zip-файла
    	fso.DeleteFile fpath_zip
    
    	'восстановление битых файлов из папки
    	Dim script_path: script_path = fso.GetParentFolderName(Wscript.ScriptFullName)
    	fso.CopyFolder script_path & "\" & SUBDIR_XLS_SRC, extract_dir
    	
    	'создание zip	
    	CreateEmptyZipFile fpath_zip
    	
    	'архивирование extract_dir
    	Dim shell: set shell = CreateObject("Shell.Application")
    	Dim extract_dir_obj: set extract_dir_obj = fso.GetFolder(extract_dir)
    	shell.NameSpace(fpath_zip).CopyHere shell.NameSpace(extract_dir).Items      
    	
    	do until shell.namespace(fpath_zip).items.count = shell.namespace(extract_dir).items.count
    		wscript.sleep 1000 
    	loop
    
    	'zip -> xlsx
    	fso.MoveFile fpath_zip, fpath_fixed
    
    	'удаление unzip-папки
    	fso.DeleteFolder extract_dir, true
    
    	WScript.Echo "Исправленный файл: " & vbCrLf & fpath_fixed
    	Set shell = Nothing
    	
    end sub
    
    sub UnzipFile(fpath_zip, extract_dir)
    
    	'создание папки для распаковки
    	If not fso.FolderExists(extract_dir) Then
    		fso.CreateFolder(extract_dir)
    	End If
    
    	'извлечение xlsx - аналог операции контекстного меню "Распаковать в ..."
    	Dim shell: set shell = CreateObject("Shell.Application")
    	Dim sub_files: set sub_files = shell.NameSpace(fpath_zip).items
    	
    	Const FOF_SILENT = &H4&
    	Const FOF_RENAMEONCOLLISION = &H8&
    	Const FOF_NOCONFIRMATION = &H10&
    	Const FOF_ALLOWUNDO = &H40&
    	Const FOF_FILESONLY = &H80&
    	Const FOF_SIMPLEPROGRESS = &H100&
    	Const FOF_NOCONFIRMMKDIR = &H200&
    	Const FOF_NOERRORUI = &H400&
    	Const FOF_NOCOPYSECURITYATTRIBS = &H800&
    	Const FOF_NORECURSION = &H1000&
    	Const FOF_NO_CONNECTED_ELEMENTS = &H2000&
    
    	Dim args: args = FOF_SILENT + FOF_NOCONFIRMATION + FOF_NOERRORUI
    	shell.NameSpace(extract_dir).CopyHere sub_files, args
    	
    	Set shell = Nothing
    	
    end sub
    
    sub CreateEmptyZipFile(fname)
    	if fso.FileExists(fname) then
            WScript.Echo  "Файл " & fname & " уже существует", vbCritical, WScript.ScriptFullName
        end if
        
        Const ForWriting = 2
    
        Dim fp: set fp = fso.OpenTextFile(fname, ForWriting, True)
        fp.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        fp.Close
    end sub
    


    Дополнительно к скрипту в архиве прилагается папка ST1_XLSX_FIXER_DATA_v1, где лежат эталонные файлы для замещения. Можно изменять ее содержимое в целях расширения области применимости скрипта на другие варианты битых файлов. Например, добавить туда обнаруженные вами варианты нулевых файлов.

    Для работы скрипта необходимо:

    1. Скачать и распаковать архив ST1_XSLX_FIXER_v1.zip в любую папку
    2. Левой кнопкой мыши перенести один или несколько xlsx-файлов на скрипт ST1_XLSX_FIXER_v1.vbs
    3. Начнется процесс обработки каждого файла:

    4. После успешной обработки каждого файла выдается сообщение вида:



    Принцип работы скрипта:

    1. Сохраняет входной файл неизменным
    2. Создает подпапку ST1_XLSX_FIXED
    3. Создает в ST1_XLSX_FIXED переименованную в zip копию xlsx
    4. Распаковывает zip в папку и копирует поверх нее ST1_XLSX_FIXER_DATA_v1
    5. Архивирует полученную папку в zip и переименовывает полученный файл в xlsx

    Заключение

    Данные эксперимент не претендует на общность использования, используйте предлагаемое решение на свой страх и риск. Со своей стороны планирую провести более широкий эксперимент и по результатам доработать скрипт. Текущее явное ограничение — скрипт не анализирует размер замещаемых файлов при копировании из ST1_XLSX_FIXER_DATA_v1, поэтому не умеет определять, какие именно служебные файлы оказались пустыми и требуют своей замены. Скорее всего, подобный способ применим, если утеряны именно служебные файлы, а не рабочие листы из "\1\xl\worksheets".

    Также скрипт не подходит для файлов с расширением xls, созданных в версиях Excel 2003 и ранее, поскольку там используется другой формат хранения данных.

    Similar posts

    Ads
    AdBlock has stolen the banner, but banners are not teeth — they will be back

    More

    Comments 2

      +1
      Libreoffice подобные косяки после ручной перепаковки файлов автоматически исправляет
        0
        я могу читать этот заголовок again&again :)

        Only users with full accounts can post comments. Log in, please.