特殊・他 LZHファイルの解凍
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Option Explicit 'LZHファイルの解凍 '○UnLHA32.DLL（著作micco氏フリーウェア）DLサイト http://www2.nsknet.or.jp/~micco/micindex.html '○OS・マシン環境によりパスは異なります。＜例＞「c:\windows\system」又は「C:\WINNT\system32」等内に上記の「UnLHA32.DLL」をコピー '↓Declare Function（Private宣言にて下記SUBステートメントも同モジュール内に記述又はコピー） 'UNLHA32.DLLのUnlha関数使用宣言 Private Declare Function Unlha Lib "UNLHA32.DLL" (ByVal Callhwnd As Long, ByVal LHACommand As String, ByVal RetBuff As String, ByVal RetBuffSize As Long) As Long 'サブルーチン Sub LZHファイルを解凍(KaitoSakiPath As String, KaitoMotoPath As String, Msg As Boolean) '*引数Msgが「False」の場合解凍成功後そのLZHファイルを削除 Dim スペース文字対策 As String, 解凍先パス As String, 解凍LZHファイルパス As String Dim パラメータ As String, 戻値 As Long, スイッチ As String Dim UNLHA結果バッファ As String * 255 '（255バイトまで） スペース文字対策 = """" 'Documents and Settings\のようにスペースがある場合、パラメータ用に誤認識対策 スイッチ = "e" '各スイッチの詳細はmicco氏作成COMMAND.TXTを参照 解凍先パス = スペース文字対策 & KaitoSakiPath & "\" & スペース文字対策 解凍LZHファイルパス = スペース文字対策 & KaitoMotoPath & スペース文字対策 パラメータ = スイッチ & " " & 解凍LZHファイルパス & " " & 解凍先パス 戻値 = Unlha(0, パラメータ, UNLHA結果バッファ, 255) If Msg = True Then If 戻値 = 0 Then MsgBox (UNLHA結果バッファ) Else If 戻値 = 0 Then Kill KaitoMotoPath End If End Sub Sub test() LZHファイルを解凍 ThisWorkbook.Path, ThisWorkbook.Path & "\" & "*.lzh", True End Sub |