none
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">&nbsp;&nbsp;
    <input type="button" style="width: 80px" name="Cancel" id="Cancel" value="Cancel" onclick="OnClickButtonCancel">
    </td></tr>
    </table>
    </table>
    </body>
    </html>

    Friday, December 23, 2011 5:11 PM

Answers

  • You have your ZipFolder function inside your OnClickButtonOK sub. You can't do that.
    Friday, December 23, 2011 5:23 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">&nbsp;&nbsp;
    <input type="button" style="width: 80px" name="Cancel" id="Cancel" value="Cancel" onclick="OnClickButtonCancel">
    </td></tr>
    </table>
    </table>
    </body>
    </html>
    


     


    Tom Lavedas
    Sunday, December 25, 2011 4:42 PM
    Moderator

All replies

  • Is says error occurred on Function ZipFolder( myFolder, myZipFile )
    Friday, December 23, 2011 5:12 PM
  • You have your ZipFolder function inside your OnClickButtonOK sub. You can't do that.
    Friday, December 23, 2011 5:23 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.
    Sunday, December 25, 2011 4:32 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">&nbsp;&nbsp;
    <input type="button" style="width: 80px" name="Cancel" id="Cancel" value="Cancel" onclick="OnClickButtonCancel">
    </td></tr>
    </table>
    </table>
    </body>
    </html>
    


     


    Tom Lavedas
    Sunday, December 25, 2011 4:42 PM
    Moderator