7-zipで複数のフォルダやファイルを個別圧縮するバッチファイル

7-zipは従来のzipファイルよりも圧縮率の高い「7z形式」が使用できる圧縮解凍ソフトの新定番です。

標準では個別圧縮に対応していませんが、バッチファイルをつくることでドラッグ＆ドロップで個別圧縮を実現できます。

Option Explicit
 
Call Main()
 
Sub Main()
    Dim args, arg
    Dim objShell
 
    Dim arcPath
    Dim command
 
    Dim delim
    Dim dest
    Dim rtn
 
    Set args = WScript.Arguments
    '7z.exeのパスを指定してください
    arcPath = """C:\Program Files\7-Zip\7z.exe"""
 
    For Each arg In args
        rtn = ArgumentTypeCheck(arg)
        If rtn = 0 Then
            dest = arg
        ElseIf rtn = 3 Then
            '対象がファイルの場合は拡張子を取り除く
            delim = InStrRev(arg, ".", -1, 1)
            dest = Left(arg, delim - 1)
        End If
        
        Command = arcPath & " a -t7z " & """" & dest & ".7z" & """" & " " & """" & arg & """"
        
        Set objShell = WScript.CreateObject("WScript.Shell")
        objShell.Run Command, 1, True
        Set objShell = Nothing
    Next
End Sub
 
'処理対象がファイルか、ディレクトリかを判定する関数
'戻り値
' 0:フォルダ
' 1:ファイル(ショートカット)
' 2:ファイル(URLショートカット)
' 3:ファイル
' -1:不明
Function ArgumentTypeCheck(arg)
    Dim rtn
    Dim objFSO, strExName
    
    On Error Resume Next
    rtn = -1
    Set objFSO = CreateObject("Scrippting.FileSystemObject")
    If objFSO.FileExists(arg) Then
        rtn = 0
    Else
        If objFSO.FileExists(arg) Then
            strExName = objFSO.GetExtensionName(arg)
            Select Case UCase(strExName)
                Case "LNK": rtn = 1
                Case "URL": rtn = 2
                Case Else: rtn = 3
            End Select
        End If
    End If
    Set objFSO = Nothing
    ArgumentTypeCheck = rtn
End Function

7-zipのインストール状況に合わせて、18行目のパスを修整してください。

にほんブログ村