Friday, 24 November 2017

VBScript file to unzip a zip file

My main development machine continues to have problems, it is very slow. This is quite a challenge. I need to download tools to fix but these downloads are zipped. Right-clicking and selecting Extract All now no longer works. Excel VBA and Word VBA are currently broken. So I need to unzip a file using a VBScript file. Here it is.



Extract "c:\Users\Simon\Downloads\PendMoves.zip"

Private Sub Extract (sItemName)

    Dim objFSO 'As New Scripting.FileSystemObject
    set objFSO = CreateObject("Scripting.FileSystemObject")

    if not objFSO.FileExists(sItemName) then
 Wscript.Echo  sItemName + " does not exist"
    else
     Wscript.Echo  sItemName

 dim oFile 
        set oFile = objFSO.GetFile(sItemName)
 
 

        Dim sFullItemName 'As String
        sFullItemName = objFSO.GetAbsolutePathName(sItemName)
 
 dim sName
        sName = objFSO.GetFile(sFullItemName).name 

 dim sLeafName
        sLeafName = split(sName,".")(0)

 dim sParentFolder 
 sParentFolder = oFile.ParentFolder.path

 
 dim sExtractFolder 
 sExtractFolder = objFSO.BuildPath(sParentFolder,sLeafName)

        Wscript.Echo "sParentFolder: " + sParentFolder + "   sLeafname: " + sLeafname + "  sExtractFolder:" + sExtractFolder

 dim oExtractFolder
 if not objFSO.FolderExists(sExtractFolder ) then
     dim oParentFolder 
     Set oParentFolder =  objFSO.GetFolder(sParentFolder)

     set oExtractFolder = oParentFolder.SubFolders.Add(sLeafName)

     'Wscript.Echo "created extract folder: " + sExtractFolder


        else
     'Wscript.Echo "acquiring extract folder: " + sExtractFolder             
     set oExtractFolder = objFSO.GetFolder(sExtractFolder )

        end if

 if not oExtractFolder is nothing then

     'Wscript.Echo "acquired extract folder: " + sExtractFolder       
            
            Dim oApp
            set oApp = CreateObject("Shell.Application")

            oApp.Namespace(sExtractFolder).CopyHere oApp.namespace(sItemName).items
            
            Wscript.Echo "copied to extract folder: " + sExtractFolder             

        end if



    end if

End Sub


No comments:

Post a Comment