Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
'/// Получаем путь до каталога, в котором находимся
ParentFolderName = FileSytemObject.GetParentFolderName(Wscript.ScriptFullName)
'/// Строим путь для создания тестового файла
SourceFilePath = FileSytemObject.BuildPath(ParentFolderName, "Текстовый документ.txt")
'/// Создаём и заполняем файл содержимым
FileSytemObject.OpenTextFile(SourceFilePath, 2, True).write "Содержимое файла"
'/// Строим путь для создания архива
DestFilePath = FileSytemObject.BuildPath(ParentFolderName, "1.zip")
'/// Создаём класс создания ZIP файла
Set Zip = New ZipClass
'/// Создаём новый архив
Zip.CreateArchive DestFilePath
'/// Добавляем файл в архив
Zip.CopyFileToArchive SourceFilePath
'/// Закрываем архив
Zip.CloseArchive

MsgBox "Архив создан", vbInformation, "ZipClass"

Class ZipClass
    Private Shell
    Private FileSystemObject
    Private ArchiveFolder
    Private ItemsCount

    Private Sub Class_Initialize()
        Set Shell = CreateObject("Shell.Application")
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    End Sub 

    Function CreateArchive(ZipArchivePath)
        If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
            Exit Function
        End If

        Dim ZipFileHeader
        ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0)
        FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader
        Set ArchiveFolder = Shell.NameSpace(ZipArchivePath)
        If Not (ArchiveFolder is Nothing) Then CreateArchive = True
    End Function 

    Function CopyFileToArchive(FilePath)
        If (ArchiveFolder Is Nothing) Then Exit Function
        ArchiveFolder.CopyHere FilePath
        ItemsCount = ItemsCount + 1
    End Function 

    Function CopyFolderToArchive(FolderPath)
        If (ArchiveFolder Is Nothing) Then Exit Function
        ArchiveFolder.CopyHere FolderPath
        ItemsCount = ItemsCount + 1
    End Function 

    Function CloseArchive
        If (ArchiveFolder is Nothing) Then Exit Function
        Set WsriptShell = CreateObject("Wscript.Shell")
        If IsObject(Wscript) Then
            Do
                Wscript.Sleep 100
            Loop Until ArchiveFolder.Items.Count => ItemsCount
        Else
            ServerSleep
        End if
        ItemsCount = 0
    End Function

    Private Function ServerSleep
        Set WsriptShell = CreateObject("Wscript.Shell")
        Do
            WsriptShell.Popup "", 1, ""
        Loop Until ArchiveFolder.Items.Count => ItemsCount
    End Function

    Function MoveFileToArchive(FilePath)
        If (ArchiveFolder is Nothing) Then Exit Function
        ArchiveFolder.MoveHere FilePath
    End Function
End Class

' ZIP.VBS manipulates ZIP file in command line. 
' Usage: CScript.exe ZIP.VBS [-d|-e|-v] ZIPfile [files...] 
'    CScript.exe ZIP.VBS -a archive.zip 1.txt 

Option Explicit 
Dim arg 
Dim optind 

If WScript.Arguments.Count<1 Then 
 WScript.Echo "Usage: CScript.exe ZIP.VBS [-d|-e|-v] ZIPfile [files...]" 
 WScript.Quit 
End If 
arg=WScript.Arguments(optind) 
Select Case LCase(arg) 
Case "-a","-c" 
 optind=optind+1 
 Call MakeZIP() 
Case "-d" 
 optind=optind+1 
 Call DeleteZIP() 
Case "-e" 
 optind=optind+1 
 Call ExtractZIP() 
Case "-v","-l" 
 optind=optind+1 
 Call ListZIP() 
Case Else 
 If optind=WScript.Arguments.Count-1 Then 
  Call ListZIP() 
 Else 
  Call MakeZIP() 
 End If 
End Select 
WScript.Quit 

Sub MakeZIP() 
Dim fso 
Dim wShell 
Dim Shell 
Dim n 
Dim ie 
Dim ZIPfile 
Dim ZIPdata:ZIPdata="PK" & Chr(5) & Chr(6) & String(18,0) 
Dim file 
Dim Folder 
Dim FolderItem 
Dim dFolder 

If WScript.Arguments.Count<optind+2 Then 
 WScript.Echo "Arguments Missing." 
 WScript.Quit 
End If 

Set fso=CreateObject("Scripting.FileSystemObject") 
Set wShell=CreateObject("WScript.Shell") 

Set Shell=CreateObject("Shell.Application") 
For n=0 To 9 
 For Each ie In Shell.Windows 
  If Not ie.Busy Then 
   If ie.ReadyState=4 Then 
    If InStr(TypeName(ie.Document),"IShellFolderViewDual")=1 Then 
     Exit For 
    End If 
   End If 
  End If 
 Next 
 If Not IsEmpty(ie) Then Exit For 
 If n=0 Then CreateObject("WScript.Shell").Run "explorer.exe",0,True 
 WScript.Sleep 100 
Next 
If IsEmpty(ie) Then 
 WScript.Echo "Failed" 
 WScript.Quit 
End If 
Set Shell=ie.Document.Application 

ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(optind)) 
If UCase(fso.GetExtensionName(ZIPfile))<>"ZIP" Then 
 WScript.Echo "Invalid Extension Name -",fso.GetExtensionName(ZIPfile) 
 WScript.Quit 
End If 
If Not fso.FileExists(ZIPfile) Then 
 fso.CreateTextFile(ZIPfile,False).Write ZIPdata 
End If 
Set dFolder=Shell.NameSpace(ZIPfile) 
For optind=optind+1 To WScript.Arguments.Count-1 
 file=fso.GetAbsolutePathName(WScript.Arguments(optind)) 
 Set Folder=Shell.NameSpace(fso.GetParentFolderName(file)) 
 Set FolderItem=Folder.ParseName(fso.GetFileName(file)) 
 If FolderItem Is Nothing Then 
  WScript.Echo WScript.Arguments(optind),"- Not Found." 
  WScript.Quit 
 End If 
 dFolder.CopyHere FolderItem 
Next 
End Sub 

Sub ListZIP() 
Dim fso 
Dim Shell 
Dim ZIPfile 
Dim Folder 
Dim FolderItem 
Dim k 
Dim COL:COL=8 
Dim cols 
ReDim cols(COL) 
Dim rows 
Dim j 

If WScript.Arguments.Count<optind+1 Then 
 WScript.Echo "Arguments Missing." 
 WScript.Quit 
End If 

Set fso=CreateObject("Scripting.FileSystemObject") 
Set Shell=CreateObject("Shell.Application") 
ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(optind)) 
If UCase(fso.GetExtensionName(ZIPfile))<>"ZIP" Then 
 WScript.Echo "Invalid Extension Name -",fso.GetExtensionName(ZIPfile) 
 WScript.Quit 
End If 
Set Folder=Shell.NameSpace(ZIPfile) 
ReDim rows(Folder.Items.Count) 
For k=0 To COL 
 cols(k)=Folder.GetDetailsOf(,k) 
Next 
j=0 
rows(j)=Join(cols,vbTab) 
For Each FolderItem In Folder.Items 
 For k=0 To COL 
  Cols(k)=Folder.GetDetailsOf(FolderItem,k) 
 Next 
 j=j+1 
 rows(j)=Join(cols,vbTab) 
Next 
WScript.Echo Join(rows,vbCRLF) 
End Sub 

Sub DeleteZIP() 
Dim fso 
Dim Shell 
Dim ZIPfile 
Dim Folder 
Dim FolderItem 

If WScript.Arguments.Count<optind+2 Then 
 WScript.Echo "Arguments Missing." 
 WScript.Quit 
End If 

Set fso=CreateObject("Scripting.FileSystemObject") 
Set Shell=CreateObject("Shell.Application") 
ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(optind)) 
If UCase(fso.GetExtensionName(ZIPfile))<>"ZIP" Then 
 WScript.Echo "Invalid Extension Name -",fso.GetExtensionName(ZIPfile) 
 WScript.Quit 
End If 
Set Folder=Shell.NameSpace(ZIPfile) 
For optind=optind+1 To WScript.Arguments.Count-1 
 Set FolderItem=Folder.ParseName(WScript.Arguments(optind)) 
 If FolderItem Is Nothing Then 
  WScript.Echo WScript.Arguments(optind),"- Not Found." 
  WScript.Quit 
 End If 
' FolderItem.InvokeVerb("delete") 
 FolderItem.InvokeVerb("??(&D)") 
Next 
End Sub 

Sub ExtractZIP() 
Dim fso 
Dim Shell 
Dim ZIPfile 
Dim Folder 
Dim FolderItem 
Dim dFolder 

If WScript.Arguments.Count<optind+1 Then 
 WScript.Echo "Arguments Missing." 
 WScript.Quit 
End If 

Set fso=CreateObject("Scripting.FileSystemObject") 
Set Shell=CreateObject("Shell.Application") 
ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(optind)) 
If UCase(fso.GetExtensionName(ZIPfile))<>"ZIP" Then 
 WScript.Echo "Invalid Extension Name -",fso.GetExtensionName(ZIPfile) 
 WScript.Quit 
End If 
Set Folder=Shell.NameSpace(ZIPfile) 
Set dFolder=Shell.NameSpace(fso.GetAbsolutePathName("")) 
If WScript.Arguments.Count<optind+2 Then 
 dFolder.CopyHere Folder.Items 
Else 
 For optind=optind+1 To WScript.Arguments.Count-1 
  Set FolderItem=Folder.ParseName(WScript.Arguments(optind)) 
  If FolderItem Is Nothing Then 
   WScript.Echo WScript.Arguments(optind),"- Not Found." 
   WScript.Quit 
  End If 
  dFolder.CopyHere FolderItem 
 Next 
End If 
End Sub