◆概要
　この資料は、Microsoft AccessでファイルのコピーとLZHファイルをUnlha32.dllで解凍する方法について記載しています。


　ファイルのコピーとLZHファイルをUnlha32.dllで解凍するには、Windows APIを使う必要があります。 　次の例は、C:\にあるken_all.lzhというLZHファイルをデータベースのカレントドライブにコピーして解凍します。

Option Compare Database
Option Explicit

' LHA
Declare Function Unlha Lib "UNLHA32.DLL" _
    (ByVal hWnd As Long, ByVal szCmdLine As String, _
    ByVal szOutput As String, ByVal iSize As Integer) As Integer
    
' ファイルコピー
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
    (ByVal lpExistringFileName As String, ByVal lpNewFileName As String, _
    ByVal bFailIfExists As Long) As Long

Public Sub データコピーと解凍()
    ' C:\にあるLZHファイルをデータベースのあるフォルダにコピーして
    ' 解凍します。
    
    Dim szOutput As String * 8000
    Dim Tmp As Variant
    Dim intWindowHandle As Long
    Dim Lhastrings As String
    Dim strSrc, strDst, lngRtn As Long
    Dim Cur_Folder As String
    
    Const LZHname As String = "ken_all.lzh"
    ' データベースのあるフォルダ名の取得
    Cur_Folder = PickFolder(CurrentDb.Name)
    ' C:\からコピー
    strSrc = "C:\" & LZHname
    strDst = Cur_Folder & "\" & LZHname
    lngRtn = CopyFile(strSrc, strDst, False)
    ' カレントフォルダをデータベースのあるフォルダに変更
    ChDir (Cur_Folder)
    ' Unlha32.dllで解凍
    intWindowHandle = Application.hWndAccessApp
    Lhastrings = "e " & LZHname
    Tmp = Unlha(intWindowHandle, Lhastrings, szOutput, Len(szOutput))
    
End Sub

Function PickFolder(FileName As String) As String
    'フルパスのファイル名からフォルダを取り出す関数
    '例:pickFolder("C:\秀和\パワーガイド\例題.mdb"は、
    '   "C:\秀和\パワーガイド"を返します
    
    Dim wlen As Integer, i As Integer, j As Integer
    
    wlen = Len(FileName)    'ファイル名の長さを得る
    'iをファイル名の長さから1まで逆にカウントし繰り返す
    For i = wlen To 1 Step -1
        'FileNameのi文字から"\"があるかを調べる
        j = InStr(i, FileName, "\")
        If j <> 0 Then          '見つかったら
            Exit For            'Loopを抜ける
        End If
    Next i
    '最初の文字まで探して"\"が見つからなかったら
    If j = 0 Then
        PickFolder = ""     '長さ0の文字列を返す
    Else
        '"\"が３文字目だったらはじめから3文字を返す
        If j = 3 Then
            PickFolder = Mid$(FileName, 1, 3)
        'そうでなければはじめから最後の"\"の前までを返す
        Else
            PickFolder = Mid$(FileName, 1, j - 1)
        End If
    End If
End Function