Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for zipdirxp.vbs

(view source code of zipdirxp.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim arrResult
  4.  
  5. arrResult = ZipFolder( "C:\Documents and Settings\MyUserID\Application Data", "C:\MyUserID.zip" )
  6. If arrResult(0) = 0 Then
  7. 	If arrResult(1) = 1 Then
  8. 		WScript.Echo "Done; 1 empty subfolder was skipped."
  9. 	Else
  10. 		WScript.Echo "Done; " & arrResult(1) & " empty subfolders were skipped."
  11. 	End If
  12. Else
  13. 	WScript.Echo "ERROR " & Join( arrResult, vbCrLf )
  14. End If
  15.  
  16.  
  17. Function ZipFolder( myFolder, myZipFile )
  18. ' This function recursively ZIPs an entire folder into a single ZIP file,
  19. ' using only Windows' built-in ("native") objects and methods.
  20. '
  21. ' Last Modified:
  22. ' October 12, 2008
  23. '
  24. ' Arguments:
  25. ' myFolder   [string]  the fully qualified path of the folder to be ZIPped
  26. ' myZipFile  [string]  the fully qualified path of the target ZIP file
  27. '
  28. ' Return Code:
  29. ' An array with the error number at index 0, the source at index 1, and
  30. ' the description at index 2. If the error number equals 0, all went well
  31. ' and at index 1 the number of skipped empty subfolders can be found.
  32. '
  33. ' Notes:
  34. ' [1] If the specified ZIP file exists, it will be overwritten
  35. '     (NOT APPENDED) without notice!
  36. ' [2] Empty subfolders in the specified source folder will be skipped
  37. '     without notice; lower level subfolders WILL be added, wether
  38. '     empty or not.
  39. ' [3] There seems to be an undocumented limit to the number of files
  40. '     that can be added, possibly due to timeouts; limits may vary from
  41. '     200 to 700 files; better stay well below 200 files just to be safe.
  42. ' [4] ZIP files can NEVER exceed 2 GB! This is a limitation in the ZIP
  43. '     format itself.
  44. '
  45. ' Based on a VBA script (http://www.rondebruin.nl/windowsxpzip.htm)
  46. ' by Ron de Bruin, http://www.rondebruin.nl
  47. '
  48. ' (Re)written by Rob van der Woude
  49. ' http://www.robvanderwoude.com
  50.  
  51. 	' Standard housekeeping
  52. 	Dim intSkipped, intSrcItems
  53. 	Dim objApp, objFolder, objFSO, objItem, objTxt
  54. 	Dim strSkipped
  55.  
  56. 	Const ForWriting = 2
  57.  
  58. 	intSkipped = 0
  59.  
  60. 	' Make sure the path ends with a backslash
  61. 	If Right( myFolder, 1 ) <> "\" Then
  62. 		myFolder = myFolder & "\"
  63. 	End If
  64.  
  65. 	' Use custom error handling
  66. 	On Error Resume Next
  67.  
  68. 	' Create an empty ZIP file
  69. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  70. 	Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
  71. 	objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
  72. 	objTxt.Close
  73. 	Set objTxt = Nothing
  74.  
  75. 	' Abort on errors
  76. 	If Err Then
  77. 		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
  78. 		Err.Clear
  79. 		On Error Goto 0
  80. 		Exit Function
  81. 	End If
  82.  
  83. 	' Create a Shell object
  84. 	Set objApp = CreateObject( "Shell.Application" )
  85.  
  86. 	' Copy the files to the compressed folder
  87. 	For Each objItem in objApp.NameSpace( myFolder ).Items
  88. 		If objItem.IsFolder Then
  89. 			' Check if the subfolder is empty, and if
  90. 			' so, skip it to prevent an error message
  91. 			Set objFolder = objFSO.GetFolder( objItem.Path )
  92. 			If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
  93. 				intSkipped = intSkipped + 1
  94. 			Else
  95. 				objApp.NameSpace( myZipFile ).CopyHere objItem
  96. 			End If
  97. 		Else
  98. 			objApp.NameSpace( myZipFile ).CopyHere objItem
  99. 		End If
  100. 	Next
  101.  
  102. 	Set objFolder = Nothing
  103. 	Set objFSO    = Nothing
  104.  
  105. 	' Abort on errors
  106. 	If Err Then
  107. 		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
  108. 		Set objApp = Nothing
  109. 		Err.Clear
  110. 		On Error Goto 0
  111. 		Exit Function
  112. 	End If
  113.  
  114. 	' Keep script waiting until compression is done
  115. 	intSrcItems = objApp.NameSpace( myFolder  ).Items.Count
  116. 	Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
  117. 		WScript.Sleep 200
  118. 	Loop
  119. 	Set objApp = Nothing
  120.  
  121. 	' Abort on errors
  122. 	If Err Then
  123. 		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
  124. 		Err.Clear
  125. 		On Error Goto 0
  126. 		Exit Function
  127. 	End If
  128.  
  129. 	' Restore default error handling
  130. 	On Error Goto 0
  131.  
  132. 	' Return message if empty subfolders were skipped
  133. 	If intSkipped = 0 Then
  134. 		strSkipped = ""
  135. 	Else
  136. 		strSkipped = "skipped empty subfolders"
  137. 	End If
  138.  
  139. 	' Return code 0 (no error occurred)
  140. 	ZipFolder = Array( 0, intSkipped, strSkipped )
  141. End Function
  142.  

page last modified: 2025-10-11; loaded in 0.0102 seconds