トップページ(目次)

284.エクセルやPDFなどをパスワード付きZIPファイルで出力保存する(圧縮ソフトLhaplus使用)
Sub エクセルやPDFなどをパスワード付きZIPファイルで出力保存する_圧縮ソフトLhaplus使用()
    
    'パスワードを指定
    パスワード = "123456"
    
    'Lhaplusをインストールしている場所を指定、基本は変更不要
    Lhaplus = "C:\Program Files (x86)\Lhaplus\Lhaplus.exe"
    
    '圧縮したいファイルをフルパスで指定
    元ファイル = "C:\サンプル.pdf"
    
    '圧縮後のzipファイル名をフルパスで指定
    ZIPファイル = "C:\サンプル.zip"
    
    'このまま流用可能
    ZIP圧縮実行 = """" & Lhaplus & """" & " /c:zip" & " /p:" & _
    パスワード & " /n:""" & ZIPファイル & """ """ & 元ファイル & """"
    
    'ここで圧縮を実行
    CreateObject("Wscript.Shell").Run "" & ZIP圧縮実行 & ""

End Sub
For・・・next と Dir() を活用すれば、フォルダに入っているすべてのファイルを 連続で圧縮していくことも可能です。こんな感じです。
Sub フォルダ内のすべてのファイルをパスワード付きZIPで出力保存する_圧縮ソフトLhaplus使用()

    圧縮対象ファイル = Dir(ThisWorkbook.Path & "\*.*")
    
    Do
        
        'パスワードを指定
        パスワード = "123456"
        
        'Lhaplusをインストールしている場所を指定、基本は変更不要
        Lhaplus = "C:\Program Files (x86)\Lhaplus\Lhaplus.exe"
        
        '圧縮したいファイルをフルパスで指定
        元ファイル = ThisWorkbook.Path & "\" & 圧縮対象ファイル
        
        '圧縮後のzipファイル名をフルパスで指定
        ZIPファイル = ThisWorkbook.Path & "\" & 圧縮対象ファイル & ".zip"
        
        'このまま流用可能
        ZIP圧縮実行 = """" & Lhaplus & """" & " /c:zip" & " /p:" & _
        パスワード & " /n:""" & ZIPファイル & """ """ & 元ファイル & """"
        
        'ここで圧縮を実行
        CreateObject("Wscript.Shell").Run "" & ZIP圧縮実行 & ""
        
        
        圧縮対象ファイル = Dir() '次のファイルを取得する
        
    Loop While 圧縮対象ファイル <> "" '次のファイルがなくなるまでループする

End Sub

Copyright © 2021 https://excel3000.web.fc2.com/ All Rights Reserved.
    inserted by FC2 system