VBS that triggers a macro via HTA (Cannot run the

2020-05-01 08:35发布

问题:

I have a HTA script which ultimately triggers the vbs portion of the code to call a VBA macro but for some reason I'm getting this error:

I've already made sure that Trust access to VBA is enabled so I feel like it's something in my code that isn't HTA compatible. Here is the code: Thank you in advance for you time.

<html>
 <title>Report Generation</title>
<head>
<HTA:APPLICATION 
 APPLICATIONNAME="Report Generation"
 ID="objHTA"  
 SCROLL="yes"
 SINGLEINSTANCE="yes"
 WINDOWSTATE="normal">
</head>

<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 10px;
margin-left: 20px;
margin-right: 20px;
margin-bottom: 5px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}                     
#scroll
{
height:100%;
overflow:auto;
}
SELECT.FixedWidth 
{
width: 17em;  /* maybe use px for pixels or pt for points here */
}
</style>

<script language="vbscript">
Option Explicit    

Dim WinWidth : WinWidth = 350
Dim WinHeight : WinHeight = 250
Window.ResizeTo WinWidth, WinHeight


Sub Sleep(lngDelay)
  CreateObject("WScript.Shell").Run "Timeout /T " & lngDelay & " /nobreak", 0, True
End Sub

Sub CheckBoxChange
  If CheckBox(0).Checked Then
  ExecuteScoreCard
  Else
  MsgBox "CheckBox is not checked"
  End If
End Sub

Sub ExecuteScoreCard() 
  Dim sitecode
  Dim objExcel  
  Dim objWorkbook
  Dim objSheet

  dim fso: set fso = CreateObject("Scripting.FileSystemObject")
  dim path: path = fso.GetAbsolutePathName(".")

  Set objExcel = CreateObject("Excel.Application")
  Set objWorkbook = objExcel.Workbooks.Open(path & "\Scorecard.xlsm")
  Set objSheet = objWorkbook.Worksheets("Cover Tab") 

  sitecode = document.getElementById("sitecode").value

  objSheet.Cells(4, 2) = sitecode
  objExcel.Run "RefreshConns"
  Sleep 75 

  objExcel.ActiveWorkbook.SaveAs path & "\Scorecards\" & "Scorecard_" & sitecode & "_" & Year(Now()) & Month(Now()) & Day(Now()) & "_" & Hour(Now()) & Minute(Now()) &".xlsm", 52
  objExcel.ActiveWorkbook.Close
  objExcel.Quit   

  MsgBox("Successfully generated scorecard.")

End Sub 

 Sub ExitProgram
  window.close()
 End Sub

</script>

<body>
  Site Code: <input type="inputbox" name="sitecode" id="sitecode">
<br>
  <input type="checkbox" name="CheckBox"> Scorecard
<br>
  <input type="checkbox" name="CheckBox"> Report2
<br>
  <input type="checkbox" name="CheckBox"> Report3
<br>
<br>
  <input type="submit" name="accept" value="Submit" onclick="CheckBoxChange">
  <input type="button" value="Exit" onClick="ExitProgram">
</body>
</html> 

回答1:

objWorkbook.RunAutoMacros(1)

Include above line of code in HTA code before the objExcel.Run "RefreshConns" line.