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

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