7zipのコマンドラインでフォルダ内圧縮ファイルを解凍

6/13 修正一部記号を含むファイルが正しく解凍できていませんでした

まだエラーが出ることがあるけど理由がわからないので分かり次第修正します

7zipのコマンドラインを使用しています

7zipをインストール並びに環境パスを通していないとエラーが出ます

VBSのプログラムです

手元ではしっかり動いていますが環境差があるかもしれないです

windows10で確認してます

オブジェクト解放してないので必要と思うのであれば自分で追加してください

やってること

　　(同じ名前のフォルダは解凍時は上書き・移動時は削除します)

長いので残りはつづきから

Option Explicit

'無くても別に困らない

Dim WshShell,ScFile,Folder1,Arr,Folder2,subfolder,subfolder2

'お好きな変数名をご使用ください

Set ScFile = CreateObject("Scripting.FileSystemObject")

Set WshShell = CreateObject("WScript.Shell")

set Folder1 = ScFile.GetFolder("解凍元")

'解凍元：太字のところに解凍したいファイルのあるフォルダのパスを入れてください

set Folder2 = ScFile.GetFolder("解凍先")

'解凍先：太字のところに解凍したフォルダを置きたいフォルダのパスを入れてください

For Each Arr In Folder1.Files

WshShell.Run ""&"7z x " & Folder1 & "\""" & Arr.Name & """ -y -spe -o"& Folder2 &"\""" & ScFile.getBaseName(Arr.Name) &"""", 0, true

'7zipを環境パスに登録してないとエラー吐きます　環境パスに関しては調べてください

for each subfolder in Folder2.subfolders

'サブフォルダを取得

for each subfolder2 in ScFile.GetFolder(subfolder).subfolders

'サブサブフォルダを取得

if(subfolder2.Name=Mid(subfolder.name,1,Len(subfolder2.name)))Then

'サブフォルダの名前の一部とサブサブフォルダの名前が同じ時

if((ScFile.FolderExists(Folder2 & "\" & subfolder2.Name)))Then

'サブサブフォルダと同じ名前のフォルダが解凍先に存在する時

ScFile.DeleteFolder Folder2 & "\" & subfolder2.Name,True

'同名フォルダは移動時にエラー吐くので削除

end if

ScFile.MoveFolder Folder2 & "\" & subfolder.Name & "\" & subfolder2.Name ,Folder2 & "\"

'サブサブフォルダを解凍先に移動

ScFile.DeleteFolder Folder2 & "\" & subfolder.Name,True

'中身が空になったサブフォルダは削除

end if

satou_gogoもしくはジョンドゥのブログ