○○
Option Compare Database
'**************************************************
' モジュール名 : Mdl_file
' 概要 : ファイル処理
'**************************************************
' FF_IsFile : ファイル存在検査
' FF_IsFolder : フォルダ存在検査
' FF_CreateFolder : フォルダ作成
' FF_CheckReadOnly : 読込専用ファイル判定
' FF_FileOpenDialog : ファイルオープンダイアログ
' FF_FileSaveDialog : ファイルセーブダイアログ
' FF_FolderDialog : フォルダ指定ダイアログ
'**************************************************
Option Explicit
' API
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal fileName As String) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
' API用構造体
Private Type OPENFILENAME ' ファイルオープンダイアログ
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type BROWSEINFO ' フォルダ参照ダイアログ
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
' 定数
Private Const FILE_ATTRIBUTE_READONLY = &H1 ' 読込専用ファイル
Private Const OFN_PATHMUSTEXIST = &H800 ' 存在パス
Private Const OFN_FILEMUSTEXIST = &H1000 ' 存在ファイル
Private Const OFN_HIDEREADONLY = &H4 ' 読込専用
Private Const BIF_RETURNONLYFSDIRS = 1 ' ディレクトリのみ
Private Const MAX_PATH_LEN = 1024 ' ファイルパス
'**************************************************
' 処理名 : ファイル存在検査
' 処理概要 : ファイルの有無を調べる
' 引数 : strPath ファイルパス
' 戻り値 : True ファイルあり
' False ファイル無し
'**************************************************
Public Function FF_IsFile(ByVal strPath As String) As Boolean
Dim fname As String ' ファイル名
FF_IsFile = False
fname = ""
If Len(strPath) > 0 Then
' 指定パスよりファイル名取得
fname = Dir(strPath, vbNormal)
' 取得文字列長検査
If Len(fname) > 0 Then
FF_IsFile = True
End If
End If
End Function
'**************************************************
' 処理名 : フォルダ存在検査
' 処理概要 : フォルダの有無を調べる
' 引数 : strPath フォルダパス
' 戻り値 : True フォルダあり
' False フォルダ無し
'**************************************************
Public Function FF_IsFolder(ByVal strPath As String) As Boolean
Dim fname As String ' フォルダ名
FF_IsFolder = False
fname = ""
If Len(strPath) > 0 Then
' 指定パスよりファイル名取得
fname = Dir(strPath, vbDirectory)
' 取得文字列長検査
If Len(fname) > 0 Then
FF_IsFolder = True
End If
End If
End Function
'**************************************************
' 処理名 : フォルダ作成
' 処理概要 : パスで指定されたフォルダまでのディレクトリ階層を作る
' 引数 : strPath フォルダパス
' 戻り値 : True 成功
' False 失敗
'**************************************************
Public Function FF_CreateFolder(ByVal strPath As String) As Boolean
Dim directory() As String
Dim i As Integer
Dim tmp As String
FF_CreateFolder = True
If strPath = "" Then
FF_CreateFolder = False
Exit Function
End If
directory = Split(strPath, "\")
If Left(strPath, 2) = "\\" Then
tmp = "\\" & directory(2)
i = 3
Else
tmp = directory(0)
i = 1
End If
' ディレクトリ数分繰り返し
While i < UBound(directory)
tmp = tmp & "\" & directory(i)
' ディレクトリ未存在時は作成
If Not FF_IsFolder(tmp) Then
On Error GoTo ERR_CreateFolder
MkDir tmp
End If
i = i + 1
Wend
Exit Function
ERR_CreateFolder:
FF_CreateFolder = False
End Function
'**************************************************
' 処理名 : 読込専用ファイル判定
' 処理概要 : パスで指定されたファイルが読込専用か判定する
' 引数 : strPath ファイルパス
' 戻り値 : True 読込専用
' False 書込可
'**************************************************
Public Function FF_CheckReadOnly(ByVal strPath As String) As Boolean
Dim attr As Long ' ファイル属性
FF_CheckReadOnly = False
' ファイル属性取得
attr = GetFileAttributes(strPath)
' 読込専用判定
If (attr And FILE_ATTRIBUTE_READONLY) <> 0 Then
FF_CheckReadOnly = True
End If
End Function
'**************************************************
' 処理名 : ファイルオープンダイアログ
' 処理概要 : ファイルを開くダイアログを表示する
' 引数 : hWnd ウィンドウハンドル
' strFilter 拡張子指定("拡張子タイトル" & Chr(0) & "*.拡張子" & Chr(0))
' 戻り値 : 成功 ファイルフルパス
' 失敗 Null文字列
'**************************************************
Public Function FF_FileOpenDialog(ByVal hwnd As Long, ByVal strFilter As String) As String
Dim ofn As OPENFILENAME ' API用構造体
' 構造体設定
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hwnd
ofn.lpstrFile = String(MAX_PATH_LEN, Chr(0))
ofn.nMaxFile = MAX_PATH_LEN
ofn.lpstrFilter = strFilter
ofn.nFilterIndex = 1
ofn.lpstrFileTitle = String(MAX_PATH_LEN, Chr(0))
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ".\"
ofn.flags = OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST + OFN_HIDEREADONLY
' ファイルパス取得
If GetOpenFileName(ofn) = 0 Then
FF_FileOpenDialog = ""
Else
FF_FileOpenDialog = Trim(ofn.lpstrFile)
FF_FileOpenDialog = Left(FF_FileOpenDialog, InStr(FF_FileOpenDialog, vbNullChar) - 1)
End If
End Function
'**************************************************
' 処理名 : ファイルセーブダイアログ
' 処理概要 : ファイルを保存するダイアログを表示する
' 引数 : hWnd ウィンドウハンドル
' strFilter 拡張子指定("拡張子タイトル" & Chr(0) & "*.拡張子" & Chr(0))
' 戻り値 : 成功 ファイルフルパス
' 失敗 Null文字列
'**************************************************
Public Function FF_FileSaveDialog(ByVal hwnd As Long, ByVal strFilter As String) As String
Dim ofn As OPENFILENAME ' API用構造体
' 構造体設定
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hwnd
ofn.lpstrFile = String(MAX_PATH_LEN, Chr(0))
ofn.nMaxFile = MAX_PATH_LEN
ofn.lpstrFilter = strFilter
ofn.nFilterIndex = 1
ofn.lpstrFileTitle = String(MAX_PATH_LEN, Chr(0))
ofn.nMaxFileTitle = 0
ofn.lpstrInitialDir = ".\"
ofn.flags = OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
' ファイルパス取得
If GetSaveFileName(ofn) = 0 Then
FF_FileSaveDialog = ""
Else
FF_FileSaveDialog = Trim(ofn.lpstrFile)
FF_FileSaveDialog = Left(FF_FileSaveDialog, InStr(FF_FileSaveDialog, vbNullChar) - 1)
End If
End Function
'**************************************************
' 処理名 : フォルダ指定ダイアログ
' 処理概要 : フォルダを指定するダイアログを表示する
' 引数 : hWnd ウィンドウハンドル
' 戻り値 : 成功 フォルダフルパス
' 失敗 Null文字列
'**************************************************
Public Function FF_FolderDialog(ByVal hwnd As Long) As String
Dim udtBrowseInfo As BROWSEINFO ' API用構造体
Dim lpIDList As Long ' 選択フォルダのID値
Dim buff As String ' ディレクトリパス格納バッファ
buff = ""
' 親ハンドル設定
udtBrowseInfo.hwndOwner = hwnd
' ディレクトリのみ選択可
udtBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
' フォルダ参照ダイアログ呼出
lpIDList = SHBrowseForFolder(udtBrowseInfo)
' ディレクトリパス取得
If lpIDList Then
buff = String(MAX_PATH_LEN, vbNullChar)
SHGetPathFromIDList lpIDList, buff
buff = Left(buff, InStr(buff, vbNullChar) - 1)
' 「\」付加
If Right(buff, 1) <> "\" Then
buff = buff & "\"
End If
End If
FF_FolderDialog = buff
End Function