I have created on HTA file with following code with VBScript. If I run the script alone it works fine but when I use it inside HTA it says syntax error on function call. Please help me. Code is given below.
<html>
<head>
<title>Working ZIP</title>
<HTA:APPLICATION
APPLICATIONNAME="Working ZIP"
ID="WorkingZIP"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
SCROLL="no"
VERSION="1.0"/>
</head>
<script language="VBScript">
Option Explicit
Sub Window_OnLoad
Dim width,height
width=600
height=800
self.ResizeTo width,height
self.MoveTo (screen.AvailWidth-width)/2,(screen.AvailHeight-height)/2
'This method will be called when the application loads
'Add your code here
End Sub
Sub OnClickButtonOK()
'This method will be called when OK is clicked
'Add your code here
Dim arrResult
arrResult = ZipFolder( "D:\NONSENSE\IDIOT", "D:\NONSENSE\IDIOT.zip" )
If arrResult(0) = 0 Then
If arrResult(1) = 1 Then
WScript.Echo "Done; 1 empty subfolder was skipped."
Else
WScript.Echo "Done; " & arrResult(1) & " empty subfolders were skipped."
End If
Else
WScript.Echo "ERROR " & Join( arrResult, vbCrLf )
End If
Function ZipFolder( myFolder, myZipFile )
' Standard housekeeping
Dim intSkipped, intSrcItems
Dim objApp, objFolder, objFSO, objItem, objTxt
Dim strSkipped
Const ForWriting = 2
intSkipped = 0
' Make sure the path ends with a backslash
If Right( myFolder, 1 ) <> "\" Then
myFolder = myFolder & "\"
End If
' Use custom error handling
On Error Resume Next
' Create an empty ZIP file
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
objTxt.Close
Set objTxt = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
' Create a Shell object
Set objApp = CreateObject( "Shell.Application" )
' Copy the files to the compressed folder
For Each objItem in objApp.NameSpace( myFolder ).Items
If objItem.IsFolder Then
' Check if the subfolder is empty, and if
' so, skip it to prevent an error message
Set objFolder = objFSO.GetFolder( objItem.Path )
If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
intSkipped = intSkipped + 1
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Next
Set objFolder = Nothing
Set objFSO = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Set objApp = Nothing
Err.Clear
On Error Goto 0
Exit Function
End If
' Keep script waiting until compression is done
intSrcItems = objApp.NameSpace( myFolder ).Items.Count
Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
WScript.Sleep 200
Loop
Set objApp = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
' Restore default error handling
On Error Goto 0
' Return message if empty subfolders were skipped
If intSkipped = 0 Then
strSkipped = ""
Else
strSkipped = "skipped empty subfolders"
End If
' Return code 0 (no error occurred)
ZipFolder = Array( 0, intSkipped, strSkipped )
End Function
'window.Close
End Sub
Sub OnClickButtonCancel()
'This method will be called when Cancel is clicked
'Add your code here
'Option Explicit
window.Close
End Sub
</script>
<body bgcolor="buttonface">
<table border=0 width=100% height=100%>
<tr><td height=100% width=100% valign=top align=left>
<!--Add your controls here-->
<!--{{InsertControlsHere}}-Do not remove this line-->
</td></tr>
<tr><td align=right>
<input type="button" style="width: 80px" name="OK" id="OK" value="OK" onclick="OnClickButtonOK">
<input type="button" style="width: 80px" name="Cancel" id="Cancel" value="Cancel" onclick="OnClickButtonCancel">
</td></tr>
</table>
</table>
</body>
</html>
