特殊・他 LZHファイルの解凍

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][特殊・他 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





Production Japan Import Application. Since 1998