Author Options:

Script to open up pptx or .xlsx files? Answered

My hard drive is no longer working. I took it to a company to recover data from this disk. But most of the files have no original names. And besides, they don't open, probably as a result of damage.
Is it possible to write a script to automatically try to open a file with the extension. pptx or .xlsx?
Is it possible to make it so that the whole good files has been moved for example in the folder
'C:\Success'. The files that are corrupt in folder 'C:\Failed'.
I'm not sure whether it is possible to do so? Maybe there is any guide how to restore them or utilities whether paid or free?



Best Answer 3 years ago

Ok I have
done 1 (XLSX) for you. I am sure you can replicate it for DOCX and PPTX ;)

Let me know
if you are still stuck. I have commented the code. Copy the code in a notepad
and rename the file with a vbs extention. Also before you run the file, change
the input and output folder.

Hope this

If this script will not restore .pptx files, I know one good tool PPTX Repair Kit for ms powerpoint pptx file repair. http://www.pptx.repair/

Code Sample


Dim Ar, strInputFolder, strOutputFolder

Dim oXLApp, wbTest

'~~> This is the folder which has the 6000 File

strInputFolder = "E:\Sample\"

'~~> Output Folder

strOutputFolder = "E:\Sample\Success\"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set FLD = FSO.GetFolder(strInputFolder)

'~~> Loop through all files in a folder

For Each FIL In FLD.Files

'~~> Get the File Extention

Ar = Split(FIL.Name,
".", -1, 0)

'~~> Check the extension

Select Case

Case "DOCX"

'~~> Replicate Code
using Code for "XLSX"

Case "PPTX"

'~~> Replicate Code
using Code for "XLSX"

Case "XLSX"

'~~> Establish an
EXCEL application object

On Error Resume Next

Set oXLApp = GetObject(,

'~~> If not found then
create new instance

If Err.Number <> 0 Then

Set oXLApp =

End If


On Error GoTo 0

'~~> Hide Excel

oXLApp.Visible = False

'~~> Open files

On Error Resume Next

Set wbTest =
oXLApp.Workbooks.Open(strInputFolder & FIL.Name)

On Error GoTo 0

If Not wbTest Is Nothing

wbTest.Close (False)

Set wbTest = Nothing

'~~> Copy the file

FSO.GetFile(strInputFolder & FIL.Name).Copy _

strOutputFolder &
FSO.GetFileName(strInputFolder & FIL.Name), True

End If

End Select


'~~> Clean Up


Set oXLApp = Nothing

MsgBox "Done"


3 years ago

Try to open such file via Recuva or some online services which are very popular now.


3 years ago

I gave them the drive that they have extracted data from it. they did, but apparently they extracted them already damaged.


3 years ago

If you had the data recovered but it is useless then you either choose the wrong company or got ripped off.
Besides: If you can't open them with the correct program, what difference would a script have? Damaged and useless is the same for the script as for the original program.
Smart people create backups of important files ;)