ToInfinityAndBeyond

' This script goes through every subfolder in the specified folder. If the folder has CSV's, it will Zip them and delete the CSV files
' It gets the Zip file name via the specific path name and alters it slightly
sevzpath = "C:\7z\7z.exe" ' Set the path to the 7zip exe, MUST NOT HAVE SPACES
homedir = "P:\Path\Folder" ' Set starting directory
' Do not edit bellow here unless you know what you are doing
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = homedir
Wscript.Echo "Starting Archive Process in: " & objStartFolder
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
    dim ZipsMade
    For Each Subfolder in Folder.SubFolders
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        dim x,i
        i = 0
        For each x in objFolder.Files ' Goes throug each file in subfolder
            Dim fso
            Set fso = CreateObject("Scripting.FileSystemObject")
            GetAnExtension = fso.GetExtensionName(x) ' Gets extension of current file
            If GetAnExtension = "csv" Then ' If File is a CSV, adds to a counter
                i = i + 1
            End If
        Next
        if i>0 Then ' Checks counter, if there is at least 1 CSV file in folder, will go through
            dim pathlength
            pathname1=Subfolder.Path
            pathlength=Len(pathname1) ' Finds How Many Characters current Subfolder has
            pathname2 = Right(pathname1,pathlength-41) ' Removes the first 38 characters from path edit for your own use
            pathname3 = Replace(pathname2,"\",".") ' Replaces \ with .
            Dim oShell
            Set oShell = WScript.CreateObject ("WScript.Shell")
            oShell.Run sevzpath & " -tzip a " & Subfolder.Path & "\" & pathname3 & ".Archive.zip " & Subfolder.Path & "\*.csv", 7, true ' Zips the file with 7z with specified name
            Set oShell = Nothing
            Dim oShell2
            Set oShell2 = CreateObject("Scripting.FileSystemObject")
            oShell2.DeleteFile(Subfolder.Path & "\*.csv") ' Deletes CSV files in folder
            Set oShell2 = Nothing
            ZipsMade = ZipsMade + 1
        end If
        ShowSubFolders Subfolder
    Next
End Sub
Wscript.Echo "Number of Zip Files Made: " & ZipsMade