.htaでvbscriptを利用する

いまさら…2020年やぞ

　現在ではActiveXはIE上では基本的に使用禁止でセキュリティ落としてまで使うのはどうなのということで.hta上で使う。vbscript部分はgalife様を主に参考にさせていただきました。

<html><head>
<title>HTAのサンプル</title>
<script language="VBScript">

dim setdata(10)
dim getdata(10)


Sub Main ()
  'On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet
  Set objXls = CreateObject("Excel.Application")
  'If Not objXls Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  
  objXls.Visible = True
 
  ' シート名を名称で指定して取得。1から始まるインデックスで指定もできる。
   Set objSheet = objWorkbook.Sheets("Sheet1")
   objSheet.Activate
  ' データ取得範囲を指定
  for i=1 to 10
    setdata(i)=objSheet.cells(i,1).Text
  next
  
 
  ' アクティブシートに設定
  
  'WScript.Sleep 3000

for i =1 to 10 
  objSheet.Cells(i,3).Value = setdata(i)
next  

' …いろいろ処理する…
  'objWorkbook.Close
  'objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function

' …メインを呼び出す…

Main

</script>
</head>
<body>
処理を終えたら閉じてください

</body></html>

test.hta
​x
 
<html><head>
<title>HTAのサンプル</title>
<script language="VBScript">
​
dim setdata(10)
dim getdata(10)
​
​
Sub Main ()
  'On Error Resume Next
 
  Dim objXls, objWorkbook, objSheet
  Set objXls = CreateObject("Excel.Application")
  'If Not objXls Then Exit Sub
  Set objWorkbook = objXls.Workbooks.Open(GetCurrentDirectory() & "\test.xlsx")
  
  objXls.Visible = True
 
  ' シート名を名称で指定して取得。1から始まるインデックスで指定もできる。
   Set objSheet = objWorkbook.Sheets("Sheet1")
   objSheet.Activate
  ' データ取得範囲を指定
  for i=1 to 10
    setdata(i)=objSheet.cells(i,1).Text
  next
  
 
  ' アクティブシートに設定
  
  'WScript.Sleep 3000
​
for i =1 to 10 
  objSheet.Cells(i,3).Value = setdata(i)
next  
​
' …いろいろ処理する…
  'objWorkbook.Close
  'objXls.Quit
  Set objWorkbook = Nothing
  Set objXls = Nothing
End Sub
 
Function GetCurrentDirectory()
  On Error Resume Next
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  GetCurrentDirectory = objShell.CurrentDirectory
End Function
​
' …メインを呼び出す…
​
Main
​
</script>
</head>
<body>
処理を終えたら閉じてください
​
</body></html>