ファイル制御 | VBA

'*******************************************************************************
' ファイル制御
'*******************************************************************************

'サーバー上のフォルダーを指定できるよう SetCurrentDirectory を使用する
#If VBA7 Then
    Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
#Else
    Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
#End If

'最後に開いたフォルダー
Private last_open_dir As String

'最後に保存したフォルダー
Private last_save_dir As String

'*******************************************************************************
' ファイルを開くダイアログ
'  input  : ini_dir = 初期表示フォルダー (空なら最後に開いたフォルダー)
'           filter = ファイルフィルター (例:"CSVファイル (*.csv),*.csv")
'           file_name = [out] ファイル名
'  return : 0=成功 / 1=キャンセル
'*******************************************************************************
Public Function OpenDialog(ini_dir As String, filter As String, _
                           file_name As String) As Integer

    Dim open_dir As String

    '初期表示フォルダーの設定
    If ini_dir = "" Then
        If last_open_dir = "" Then
            '初回はExcelファイルのあるフォルダー
            last_open_dir = ThisWorkbook.Path
        End If
        open_dir = last_open_dir
    Else
        open_dir = ini_dir
    End If
    SetCurrentDirectory open_dir

    file_name = Application.GetOpenFilename(FileFilter:=filter)
    If file_name = "False" Then
        OpenDialog = 1
        Exit Function
    End If

    'フォルダーを記憶
    last_open_dir = Left(file_name, InStrRev(file_name, "\") - 1)

    OpenDialog = 0

End Function

'*******************************************************************************
' ファイルを開くダイアログ (複数選択版)
'  input  : ini_dir = 初期表示フォルダー (空なら最後に開いたフォルダー)
'           filter = ファイルフィルター (例:"CSVファイル (*.csv),*.csv")
'           files_name = [out] 複数ファイル名
'  return : 0=成功 / 1=キャンセル
'*******************************************************************************
Public Function OpenDialog_Multi(ini_dir As String, filter As String, _
                                 files_name As Variant) As Integer

    Dim open_dir As String

    '初期表示フォルダーの設定
    If ini_dir = "" Then
        If last_open_dir = "" Then
            '初回はExcelファイルのあるフォルダー
            last_open_dir = ThisWorkbook.Path
        End If
        open_dir = last_open_dir
    Else
        open_dir = ini_dir
    End If
    SetCurrentDirectory open_dir

    files_name = Application.GetOpenFilename(FileFilter:=filter, _
                                             MultiSelect:=True)
    If Not IsArray(files_name) Then
        OpenDialog_Multi = 1
        Exit Function
    End If

    'フォルダーを記憶
    last_open_dir = Left(files_name(1), InStrRev(files_name(1), "\") - 1)

    OpenDialog_Multi = 0

End Function

'*******************************************************************************
' 名前を付けて保存ダイアログ
'  input  : ini_dir = 初期表示フォルダー (空なら最後に保存したフォルダー)
'           ini_file_name = 初期表示ファイル名 (空でもいい)
'           filter = ファイルフィルター (例:"CSVファイル (*.csv),*.csv")
'           file_name = [out] ファイル名
'  return : 0=成功 / 1=キャンセル
'*******************************************************************************
Public Function SaveDialog(ini_dir As String, ini_file_name As String, _
                           filter As String, file_name As String) As Integer

    Dim save_dir As String

    '初期表示フォルダーの設定
    If ini_dir = "" Then
        If last_save_dir = "" Then
            '初回はExcelファイルのあるフォルダー
            last_save_dir = ThisWorkbook.Path
        End If
        save_dir = last_save_dir
    Else
        save_dir = ini_dir
    End If
    SetCurrentDirectory save_dir

    file_name = Application.GetSaveAsFilename(InitialFileName:=ini_file_name, _
                                              FileFilter:=filter)
    If file_name = "False" Then
        SaveDialog = 1
        Exit Function
    End If

    'フォルダーを記憶
    last_save_dir = Left(file_name, InStrRev(file_name, "\") - 1)

    SaveDialog = 0

End Function

'*******************************************************************************
' ファイルの存在確認
'  input  : file_name = ファイル名 (フルパス)
'  return : True  = あり
'           False = なし
'  note   :
'*******************************************************************************
Public Function Get_FileExists(file_name As String) As Boolean

    If Dir(file_name) <> "" Then
        Get_FileExists = True
    Else
        Get_FileExists = False
    End If

End Function

'*******************************************************************************
' ファイルパスを取得
'  input  : file_name = ファイル名 (フルパス)
'  return : ファイルパス
'  note   : "C:\Users\xxx\Documents\a.txt" ⇒ "C:\Users\xxx\Documents"
'*******************************************************************************
Public Function Get_FilePath(file_name As String) As String

    Get_FilePath = Left(file_name, InStrRev(file_name, "\") - 1)

End Function

'*******************************************************************************
' ファイル名を取得
'  input  : file_name = ファイル名 (フルパス)
'  return : ファイル名
'  note   : "C:\Users\xxx\Documents\a.txt" ⇒ "a.txt"
'*******************************************************************************
Public Function Get_FileName(file_name As String) As String

    Get_FileName = Mid(file_name, InStrRev(file_name, "\") + 1)

End Function

'*******************************************************************************
' ファイルの拡張子を取得
'  input  : file_name = ファイル名 (フルパス)
'  return : 拡張子
'  note   : "C:\Users\xxx\Documents\a.txt" ⇒ "txt"
'*******************************************************************************
Public Function Get_FileExt(file_name As String) As String

    Get_FileExt = Right(file_name, Len(file_name) - InStrRev(file_name, "."))

End Function

'*******************************************************************************
' ファイルの更新日時を取得
'  input  : file_name = ファイル名 (フルパス)
'  return : 更新日時
'  note   :
'*******************************************************************************
Public Function Get_LastWriteTime(file_name As String) As Date

    Get_LastWriteTime = FileDateTime(file_name)

End Function