フォルダ

フォルダ_指定

Function f_フォルダ_指定(p_str As String) As Boolean
f_フォルダ_指定 = False
Dim folderDialog As fileDialog Dim folderExists As Boolean Dim selectedFolder As String Dim w_str As String Set folderDialog = Application.fileDialog(msoFileDialogFolderPicker) w_str = Range(p_str).Value On Error Resume Next folderExists = Dir(w_str, vbDirectory) <> "" On Error GoTo 0 If folderExists And w_str <> "" Then folderDialog.InitialFileName = Range(p_str).Value Else folderDialog.InitialFileName = ThisWorkbook.Path End If If Right(folderDialog.InitialFileName, 1) <> "\" Then folderDialog.InitialFileName = folderDialog.InitialFileName & "\" End If SendKeys "{HOME}" SendKeys "{END}" Application.DisplayAlerts = False If folderDialog.Show = -1 Then selectedFolder = folderDialog.SelectedItems(1) Worksheets("メニュー").Range(p_str).Value = selectedFolder '◆ 指定履歴追加 If f_指定履歴追加(selectedFolder, Range(p_str).Address) = False Then MsgBox "指定履歴の追加が、できませんでした。", vbOKOnly + vbExclamation, "指定履歴追加エラー" End If End If Application.DisplayAlerts = True Set folderDialog = Nothing f_フォルダ_指定 = True
End Function

フォルダ_開く

Function f_フォルダ_開く(p_name As String) As Boolean
f_フォルダ_開く = False Dim folderPath As String p_name = Range(p_name).Value If InStr(1, Mid(p_name, InStrRev(p_name, "\"), 99), ".") > 0 Then folderPath = Left(p_name, InStrRev(p_name, "\")) Else folderPath = p_name & "\" End If On Error Resume Next Shell "explorer.exe " & folderPath, vbNormalFocus If Err.Number <> 0 Then MsgBox "フォルダが開けません。ご確認下さい。", vbCritical, "開くエラー" End If On Error GoTo 0
f_フォルダ_開く = True
End Function