特殊・他 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 LongAs 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

 

 

 

2000年01月01日|[VBサンプルコード]:[特殊・他]