Answered by:
Syntax error on Function call in HTA file

Question
-
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>
Answers
-
You have your ZipFolder function inside your OnClickButtonOK sub. You can't do that.
- Marked as answer by Tom LavedasModerator Friday, December 23, 2011 6:10 PM
- Unmarked as answer by Naresh Kumar Gnanakrishnan Sunday, December 25, 2011 4:32 PM
- Proposed as answer by Tom LavedasModerator Monday, December 26, 2011 3:45 PM
- Marked as answer by Richard MuellerMVP, Moderator Friday, December 30, 2011 11:48 PM
-
Just invoke it by name where you need it at whatever point you need it. For example, ...
<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 ' Deleted - ZipFolder myFolder, myZipFile 'window.Close End Sub 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 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>
Tom Lavedas- Edited by Tom LavedasModerator Sunday, December 25, 2011 7:10 PM see marked delete
- Proposed as answer by Richard MuellerMVP, Moderator Thursday, December 29, 2011 5:23 PM
- Marked as answer by Richard MuellerMVP, Moderator Friday, December 30, 2011 11:48 PM
All replies
-
-
You have your ZipFolder function inside your OnClickButtonOK sub. You can't do that.
- Marked as answer by Tom LavedasModerator Friday, December 23, 2011 6:10 PM
- Unmarked as answer by Naresh Kumar Gnanakrishnan Sunday, December 25, 2011 4:32 PM
- Proposed as answer by Tom LavedasModerator Monday, December 26, 2011 3:45 PM
- Marked as answer by Richard MuellerMVP, Moderator Friday, December 30, 2011 11:48 PM
-
How to call Function from sub, since my requirement is to do some procedure like copy folders using sub and then zip the folder using the VBScript which has a Function call in it. If I put the Function outside sub the folders gets zipped before Folder and files being copied which is wrong. Please help me in solving this.
-
Just invoke it by name where you need it at whatever point you need it. For example, ...
<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 ' Deleted - ZipFolder myFolder, myZipFile 'window.Close End Sub 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 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>
Tom Lavedas- Edited by Tom LavedasModerator Sunday, December 25, 2011 7:10 PM see marked delete
- Proposed as answer by Richard MuellerMVP, Moderator Thursday, December 29, 2011 5:23 PM
- Marked as answer by Richard MuellerMVP, Moderator Friday, December 30, 2011 11:48 PM