Link to home
Start Free TrialLog in
Avatar of Multimatic
MultimaticFlag for Canada

asked on

Error running VBScript

Hi,
Shift-3 provided a script for me to zip all files of a chosen extension, retaining files names.  When I run it from a Windows 2003 server it comes back with an error message: Object required: 'obj.namespace(...)'. Code 800A01A8.  

Shift-3 original script: https://www.experts-exchange.com/questions/23911898/How-do-I-batch-zip-files-with-igs-extension-and-retain-original-name-and-location-then-delete-the-igs-files.html?cid=239&anchorAnswerId=22979512#a22979512 

It zips the 1st file but whilst zipping it, it comes up with the error message.  If I leave the message open, it finishes zipping the file but does not delete the original and then seems to just sit there uintil I clear the message; which closes the script.

It seems to work ok for other file types such as htm but not too well on .stl and .igs.. the types that I need to compress.  For instance I tried it on .htm and it worked.  This is why I thought it was working fine during testing as I did it against .txt and .doc files mainly.

The only change I made was setting it to include the original extension when creating the .zip; i.e. filename.igs.zip

Could it be the size of the files?

Cheers

Avatar of Shift-3
Shift-3
Flag of United States of America image

Why don't you post your revised script using the Attach Code Snippet box.

How large are the files?
Avatar of Multimatic

ASKER

Hi,
The files are between 3mb and 600mb.  

Script attached.

Cheers
'xxxx  SCRIPT TO ZIP FILES INDIVIDUALLY USING ORIGINAL FILE NAMES.  FILE EXENSIONS AND DATES CAN BE MODIFIED AS EXPLAINED BELOW XXXX
 
'***** Change the following location as required.  !!! THIS IS A RECURSIVE ACTION !!!
     strRoot = "H:\depts\05"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    Set objRoot = objFSO.GetFolder(strRoot)
    Set colFiles = objRoot.Files
 
        For Each objFile in colFiles
'***** FOLLOWING ACTION ZIPS ALL FILES OF THE STATED EXTENSION.  CHANGE THE FOLLOWING FILE EXTENSIONS AS REQUIRED *****  
    		If LCase(Right(objFile.Name, 4)) = ".igs" Or LCase(Right(objFile.Name, 4)) = ".stl" Then
'***** CHANGE THE FOLLOWING DATE AS REQUIRED.  "d" = DAY, "m" = MONTH. THE NUMBER AFTER > MEANS FILES MODIFIED AFTER THIS VALUE.  
		If DateDiff("d", objFile.DateLastModified, Now) > 7 Then
    	            strNewPath = Left(objFile.Path, Len(objFile.Path) ) & ".zip"
		    'strNewPath = Left(objFile.Path, Len(objFile.Path) - 4) & ".zip"
            	    ZipFile objFile.Path, strNewPath
                    objFile.Delete
    	        End If
    	    End If
        Next
 
    Set colSubFolders = objRoot.SubFolders
 
    For Each objFolder in colSubfolders
        GetSubFolders objFolder.Path
    Next
 
    Sub GetSubFolders(strFolderPath)
        Set objSub = objFSO.GetFolder(strFolderPath)
    
        Set colFiles2 = objSub.Files
 
        For Each objFile2 in colFiles2
'***** FOLLOWING ACTION DELETES ORIGINAL.  CHANGE THE FOLLOWING FILE EXTENSIONS AS REQUIRED ***** 
           If LCase(Right(objFile2.Name, 4)) = ".igs" Or LCase(Right(objFile2.Name, 4)) = ".stl" Then
                If DateDiff("m", objFile2.DateLastModified, Now) > 7 Then
		    strNewPath = Left(objFile2.Path, Len(objFile2.Path) ) & ".zip"
                    'strNewPath = Left(objFile2.Path, Len(objFile2.Path) - 4) & ".zip"
                    ZipFile objFile2.Path, strNewPath
                    objFile2.Delete
                End If
            End If
        Next
        
        Set colSubfolders2 = objSub.SubFolders
 
        For Each objFolder2 in colSubfolders2
            GetSubFolders objFolder2.Path
        Next
    End Sub
 
 
    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 200
        Loop
    End Sub

Open in new window

This version should handle large files.


'xxxx  SCRIPT TO ZIP FILES INDIVIDUALLY USING ORIGINAL FILE NAMES.  FILE EXENSIONS AND DATES CAN BE MODIFIED AS EXPLAINED BELOW XXXX
 
'***** Change the following location as required.  !!! THIS IS A RECURSIVE ACTION !!!
     strRoot = "H:\depts\05"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    Set objRoot = objFSO.GetFolder(strRoot)
    Set colFiles = objRoot.Files
 
        For Each objFile in colFiles
'***** FOLLOWING ACTION ZIPS ALL FILES OF THE STATED EXTENSION.  CHANGE THE FOLLOWING FILE EXTENSIONS AS REQUIRED *****  
                If LCase(Right(objFile.Name, 4)) = ".igs" Or LCase(Right(objFile.Name, 4)) = ".stl" Then
'***** CHANGE THE FOLLOWING DATE AS REQUIRED.  "d" = DAY, "m" = MONTH. THE NUMBER AFTER > MEANS FILES MODIFIED AFTER THIS VALUE.  
                If DateDiff("d", objFile.DateLastModified, Now) > 7 Then
                    strNewPath = objFile.Path & ".zip"
                    'strNewPath = Left(objFile.Path, Len(objFile.Path) - 4) & ".zip"
                    ZipFile objFile.Path, strNewPath
                    objFile.Delete
                End If
            End If
        Next
 
    Set colSubFolders = objRoot.SubFolders
 
    For Each objFolder in colSubfolders
        GetSubFolders objFolder.Path
    Next
 
    Sub GetSubFolders(strFolderPath)
        Set objSub = objFSO.GetFolder(strFolderPath)
    
        Set colFiles2 = objSub.Files
 
        For Each objFile2 in colFiles2
'***** FOLLOWING ACTION DELETES ORIGINAL.  CHANGE THE FOLLOWING FILE EXTENSIONS AS REQUIRED ***** 
           If LCase(Right(objFile2.Name, 4)) = ".igs" Or LCase(Right(objFile2.Name, 4)) = ".stl" Then
                If DateDiff("m", objFile2.DateLastModified, Now) > 7 Then
                    strNewPath = objFile2.Path & ".zip"
                    'strNewPath = Left(objFile2.Path, Len(objFile2.Path) - 4) & ".zip"
                    ZipFile objFile2.Path, strNewPath
                    objFile2.Delete
                End If
            End If
        Next
        
        Set colSubfolders2 = objSub.SubFolders
 
        For Each objFolder2 in colSubfolders2
            GetSubFolders objFolder2.Path
        Next
    End Sub
 
 
    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
            WScript.Sleep 200
            set objNameSpace = objApp.NameSpace(strArchive)
 
            If Not objNameSpace is nothing Then        
                If objNameSpace.Items.Count = intCount Then
                    Exit Do
                End If
            End If
        Loop
    End Sub

Open in new window

Hi,
I still get the error message.  I have not changed the script at all.

It seems to zip the 1st file, present the message and exit when I close the message.  It does not even delete the original file that it just zipped.


Cheers!
VB-error.doc
I'm unable to reproduce the error.  I've tested it with multiple 1.5 GB files.

If you didn't change my revised script at all then it doesn't make sense that your error is coming up on line 69.  That line only contains Do.

Are you sure you copied and pasted from the right box?
Sorry, you were correct, I pasted the worng version!  Now I get this permissions  related mesage [attached].  I definately have rights to delete and the file was not in use etc....?
Permission-error.doc
ASKER CERTIFIED SOLUTION
Avatar of Shift-3
Shift-3
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Shift-3 it seems to work fine now thanks!