0
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

HTA、VBScriptを使用したファイル解凍

Last updated at Posted at 2023-05-21

ファイル一覧から対象ファイルをチェックしてファイル解凍します。
3重、4重の圧縮ファイルの解凍に便利です。

image.png

■仕様
・「一覧表示」押下で、HTAが配置されているフォルダのファイル一覧を再帰的に生成。
・tar,zip,gz,Zのファイルは緑色表示。
・「チェックボックス」がオン、「解凍実行」を押下で7zipを使用した解凍実施。
・解凍先は圧縮ファイルと同じ。同一ファイルが存在していた場合は上書き。
・7zipの処理結果をポップアップで表示。

<html>
<head> 
<title>圧縮ファイル解凍</title> 
<HTA:APPLICATION  
     APPLICATIONNAME="圧縮ファイル解凍"
     SCROLL="yes"
     SINGLEINSTANCE="yes" 
>

<script language="VBScript">
Dim FSO
Dim REP
Dim s

'--- 起動時---
Sub Window_onLoad
  window.resizeTo 1400,900  
End Sub

'--- HTAと同一フォルダのファイル一覧作成 ---
sub MakeList()
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set REP = CreateObject("VBScript.RegExp")
  
  '--- 解凍対象識別子 ---
  REP.Pattern = ".tar$|.zip$|.Z$|.gz$"

  '--- HTMLを生成  ---  ※文字編集のときはspan contenteditable
  s = "<span><TABLE width=100% border><TR bgcolor=#FF9933><TD align=""center"">解凍対象</TD>"
  s = s & "<TD>ファイルパス</TD><TD>ファイル名</TD><TD>フルパス</TD></TR>"
  FindFolder FSO.GetFolder(".")
  s = s & "<TR><TD>END</TD><TD></TD><TD></TD><TD></TD></TABLE></span>"
  TableArea.innerHtml = s
  
  Set FSO = Nothing
  Set REP = Nothing
End Sub

'--- 再帰的にファイル一覧をtableフォーマットで作成 ---
Sub FindFolder(ByVal objMainFolder)
    Dim objSubFolder
    Dim objFile

    For Each objSubFolder In objMainFolder.SubFolders
      FindFolder objSubFolder
    Next

    For Each objFile In objMainFolder.files
      
      '--- 解凍対象を判定し解凍ボタン生成、テキスト開くボタン生成  ---
      If REP.Test(objFile.Name) Then 
        TR = "<TR bgcolor=#99ff66>"
      Else
        TR = "<TR>"
      END If
           
      '--- Tableの明細行作成  ---
      s = s & TR & "<TD align=""center""><input type=""checkbox"" /></TD><TD>" & objFile.ParentFolder
      s = s & "</TD><TD>" & objFile.Name & "</TD><TD>" & objFile.ParentFolder & "\" 
      s = s & objFile.Name &"</TD></TR>"
    Next
    
End Sub


'--- 7zipを利用して解凍する ---
Sub Tenkai()
  Dim wsh,osh
  Dim i,SZIP
  
  Set wsh = CreateObject("WScript.Shell")
  Set TABLE = document.getElementsByTagName("TABLE")(0)
  i = 0
  While TABLE.rows(i).cells(0).innerText <> "END"
    
    if TABLE.rows(i).cells(0).innerHTML = "<INPUT CHECKED type=checkbox>" then
      f_path = TABLE.rows(i).cells(1).innerText 
      f_full = TABLE.rows(i).cells(1).innerText & "\" & TABLE.rows(i).cells(2).innerText
      
      
      '---■■■7zipのパスを定義する■■---
      SZIP = "C:\Program Files\7-Zip\7z.exe"
      
      set osh = wsh.Exec(SZIP & " x -aoa ""-o" & f_path & """ """ & f_full & """")
      msgbox osh.Stdout.ReadAll
      
    End If
    
    i = i + 1
    Wend
  Set osh = Nothing
  Set wsh = Nothing
  
End Sub

Sub TextGo()
End Sub

</script></head>
<body>
■解凍するファイルとHTAを同一ディレクトリーへ配置して下さい。  ※7zipのインストールが必要です。<br>
■一覧表示を押下して下さい<br>
■解凍対象にチェックしてから「解凍実行」ボタンを押下してください。
 7zipの解凍処理結果が表示されますので確認してください。<p>
<input type="button" value="一覧表示" name="run_button1" onClick="MakeList">
<input type="button" value="解凍実行" name="run_button2" onClick="Tenkai">
<p>
<p>
<span id=TableArea></span>
<p>

</body> 
</html>
0
4
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?