Option Compare Database
Option Explicit
'---------------------------------------------------------------------
'指定されたファイルのpathを検索する
'   戻り値     正常終了 = バッファにコピーしたバイト数
'              エラー   = 0
'---------------------------------------------------------------------
Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" _
    (ByVal lpPath As String, _
     ByVal lpFileName As String, _
     ByVal lpExtension As String, _
     ByVal nBufferLength As Long, _
     ByVal lpBuffer As String, _
     ByVal lpFilePart As String) As Long

'---------------------------------------------------------------------
'既存のファイルをコピーする
'   bFailIfExistsに次のフラグを設定
'       1:同一ファイルがあればエラー
'       0:同一ファイルがあれば上書き
'   戻り値     正常終了 = 0以外
'              エラー   = 0
'---------------------------------------------------------------------
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
    (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

'---------------------------------------------------------------------
'WindowsTempPathを取得
'---------------------------------------------------------------------
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nSize As Long, ByVal lpBuffer As String) As Long

'----------------------------------------------------------------------------
'指定ディレクトリのあるディスクの空き容量を取得(２Gを超えるディスクに対応)
'   戻り値     正常終了 = 0以外
'              エラー   = 0
'GetDiskFreeSpace(LsApi1.mdbを参照) は２Gを超えるディスクに対応していません。
'----------------------------------------------------------------------------
'64bit構造体
Type Bit64
    LowPart As Long
    HighPart As Long
End Type

Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
    (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Bit64, _
    lpTotalNumberOfBytes As Bit64, _
    lpTotalNumberOfFreeBytes As Bit64) As Long

Function LsSearchPath(FileName As String, flg As Boolean) As String
    Dim lpPath As String           '検索するディレクトリ名
    Dim lpFileName As String       '検索対象のファイル名(フルパスも可能)
    Dim lpExtension As String      'lpFileNameに拡張子を持たないファイル名を指定した場合の拡張子（例 .exe）
    Dim nBufferLength As Long      'lpBufferのバイト数
    Dim lpBuffer As String * 255   'パス名を受け取るバッファ
    Dim lpFilePart As String       'ディレクトリ名なしのファイル名へのポインタ
    
    If Trim$(FileName) = "" Then
        MsgBox "ファイル名を指定して下さい"
        Exit Function
    End If
    
    'ファイルを検索するディレクトリ名を指定
    'vbNullStringを指定すると次の順に検索
    '   1.アプリケーションを起動したディレクトリ
    '   2.カレントディレクトリ
    '   3.\Windous\Systemディレクトリ
    '   4.\Windousディレクトリ
    '   5.環境変数Pathで設定したディレクトリ
    lpPath = vbNullString
    
    '検索するファイル名
    lpFileName = FileName
    
    '拡張子を指定
    lpExtension = vbNullString
    
    'lpBufferのバイト数
    nBufferLength = 255
    
    'ファイルを検索
    If SearchPath(lpPath, lpFileName, lpExtension, nBufferLength, lpBuffer, lpFilePart) > 0 Then
        LsSearchPath = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
        If flg Then MsgBox LsSearchPath
    Else
        If flg Then MsgBox "指定のはファイル見つかりません"
    End If
End Function

'WindowsTempPathを取得
Function LsGetTempPath() As String
    Dim Gwdvar As String, Gwdvar_Length As Long
    Gwdvar = Space(255)
    Gwdvar_Length = GetTempPath(nSize:=255, lpBuffer:=Gwdvar)
    '2002/10/09 Bug Fix
    'LsGetTempPath = Trim$(Left$(Gwdvar, Gwdvar_Length))
    'Gwdvarは￥で終わる
    LsGetTempPath = LsNullTrim(Gwdvar)
End Function

'Null文字以降を削除
Function LsNullTrim(strExp As String) As String
    Dim i As Integer
    i = InStr(strExp, vbNullChar)
    If i > 1 Then
        LsNullTrim = Left$(strExp, i - 1)
    Else
        LsNullTrim = strExp
    End If
End Function

Sub LsGetDiskFreeSpaceEx()
    Dim lpDirectoryName As String             '調査するディスクのディレクトリ名（カレントディレクトの場合は vbNullStringを指定）
                                              'UNC名では末尾に\を付加(例 \\server\bin\)
    Dim lpFreeBytesAvailableToCaller As Bit64 'この関数を呼び出したユーザーが使用できるディスクの空きバイト数
    Dim lpTotalNumberOfBytes As Bit64         'ディスクの総バイト数
    Dim lpTotalNumberOfFreeBytes As Bit64     'ディスクの空きバイト数
    
    lpDirectoryName = vbNullString
    'lpDirectoryName = "c:\windows"
    '（ドライブを変更してた場合は、必ずMDBを閉じてから再度開き、リコンパイルしてください）
    
    If GetDiskFreeSpaceEx(lpDirectoryName, lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes) = 0 Then
        MsgBox "GetDiskFreeSpaceExに失敗しました"
        Exit Sub
    End If
        
    MsgBox "空き容量 = " & Format(Bit64ToDec(lpTotalNumberOfFreeBytes), "#,### ﾊﾞｲﾄ") & Chr(13) & _
           "総容量 = " & Format(Bit64ToDec(lpTotalNumberOfBytes), "#,### ﾊﾞｲﾄ")
End Sub

Private Function Bit64ToDec(wBit64 As Bit64) As Variant
    Dim LowByte As Variant   '総バイト数（下位）
    Dim HighByte As Variant  '総バイト数（上位）
    Dim TotalByte As Variant '総バイト数（合計）
   
    With wBit64
        LowByte = CDec(.LowPart)
        HighByte = CDec(.HighPart)
    End With
    
    If LowByte < 0 Then
        LowByte = LowByte + 4294967296#
    End If

    TotalByte = HighByte * 4294967296# + LowByte
    
    Bit64ToDec = TotalByte
End Function