VBscipt Zip Files in a Folder

Hi. I have a script that I want to run on Server 2003. It just zips files in a folder. It runs perfect when I test it on my Win 7 machine but when I run it on my Server 2003 it runs sometimes and then errors out sometimes, even when testing it to zip the same exact files. I get a  pop up 'Compressed (zipped) Folders Error - "Cannot create output file" even though some files are in the zip file. I am zipping the same exact files I Just zipped as a test. I tried adjusting the sleep from -1 to 16000 and that doesn't seem to nail it down. It is so random on whether it works or not. Anyone ever seen this behavior or have a solid vbscript or batch that I can rely on running on Server 2003? Here is what I have:


ParcArchiveLoc = "E:\FTP\ParcOneLink\ARCHIVE"
ParcRemoteStorage = "\\rmcssfile007\CO PROD PIT APP DATA\Parc_Onelink_Archive"
Slash = "/"

Dim date
      date = CStr(Year(Now())) & CStr(prefixWithZero(Month(Now()))) & CStr(prefixWithZero(Day(Now())))
      Dim time
      time = CStr(prefixWithZero(Hour(Now()))) & CStr(prefixWithZero(Minute(Now()))) & CStr(prefixWithZero(Second(Now())))
      Dim suffix
      suffix = date & "-" & time
      
Function prefixWithZero(value)
      If value < 10 Then
    prefixWithZero = "0" & CStr(value)
      Else
    prefixWithZero = CStr(value)      
      End If      
End Function

strFolder = ParcArchiveLoc
strZip = strFolder & "\" & "Parc-OmegaFiles" & "_" & suffix & ".zip"
 
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
Set colContents = objWMIService.ExecQuery _
      ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
        & "ResultClass = CIM_DataFile")
 
For Each objFile in colContents
        ZipFile objFile.Name, strZip
        Set objFSO = CreateObject("Scripting.FileSystemObject")  
        objFSO.DeleteFile objFile.Name
Next
 
Sub ZipFile(strFileToZip, strArchive)
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
   
    If Not objFSO.FileExists(strArchive) Then
        Set objTxt = objFSO.CreateTextFile(strArchive)
        objTxt.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        objTxt.Close
    End If
 
    Set objApp = CreateObject( "Shell.Application" )
 
    intCount = objApp.NameSpace(strArchive).Items.Count + 1
 
    objApp.NameSpace(strArchive).CopyHere strFileToZip
 
    Do Until objApp.NameSpace(strArchive).Items.Count = intCount
        WScript.Sleep 500
    Loop
 
End Sub

Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile ParcArchiveLoc & Slash & "*.ODC", ParcRemoteStorage & Slash
Iused2knoAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, are you against using something like the 7-zip command line utility to do the zipping?
0
Iused2knoAuthor Commented:
I read up on all that and I believe I cannot use it. I wanted to see what I could do with the native. Like I said this works no problem on my desktop but the same script will randomly work and then not. I haven't be able to nail down anything.
 On the other hand are the zip utilities just an exe. or would I have to install it. If I have to physically run through an installer I know it'll be shot down. If I could call an .exe I think I may be able to get away with it.
0
RobSampsonCommented:
The 7-zip command line utility is a stand-alone EXE:
http://www.7-zip.org/download.html

so you could use it.  You would just do
Set objShell = CreateObject("WScript.Shell")
objShell.Run "C:\Tools\7za.exe a """ & strZip & """ """ & objFile.Name & """", 0, True

I have added that to this code
ParcArchiveLoc = "E:\FTP\ParcOneLink\ARCHIVE"
ParcRemoteStorage = "\\rmcssfile007\CO PROD PIT APP DATA\Parc_Onelink_Archive"
Slash = "/"

Dim date
date = CStr(Year(Now())) & CStr(prefixWithZero(Month(Now()))) & CStr(prefixWithZero(Day(Now())))
Dim time
time = CStr(prefixWithZero(Hour(Now()))) & CStr(prefixWithZero(Minute(Now()))) & CStr(prefixWithZero(Second(Now())))
Dim suffix
suffix = date & "-" & time

strFolder = ParcArchiveLoc
strZip = strFolder & "\" & "Parc-OmegaFiles" & "_" & suffix & ".zip"
 
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
Set colContents = objWMIService.ExecQuery _
      ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
        & "ResultClass = CIM_DataFile")
 
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objShell = CreateObject("WScript.Shell")
For Each objFile in colContents
	objShell.Run "C:\Tools\7za.exe a """ & strZip & """ """ & objFile.Name & """", 0, True
	objFSO.DeleteFile objFile.Name
Next

Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile ParcArchiveLoc & Slash & "*.ODC", ParcRemoteStorage & Slash

Function prefixWithZero(value)
      If value < 10 Then
    prefixWithZero = "0" & CStr(value) 
      Else
    prefixWithZero = CStr(value)      
      End If      
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

Iused2knoAuthor Commented:
Rob, I truly appreciate the help. This will work for me. I only had to change line 29 to .*zip because of the file extension. Thanks again.
0
RobSampsonCommented:
Great.   Glad it worked.  Makes it much easier than trying to use the inbuilt method.

Thanks for the grade.

Rob.
0
Iused2knoAuthor Commented:
You are welcome, well deserved. Again, much appreciated.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.