Option Explicit
Public Function fncDialogFolder(strMsg As String) As String '全ドライブ
'**********************************************
'フォルダ選択ダイアログを表示し選択パスを返す
'**********************************************
Dim Shell, myPath, str As String
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, strMsg & _
"をするフォルダを選んでください", &H1 + &H10, "")
If Not myPath Is Nothing Then
str = myPath.Items.Item.Path & "\"
Else 'キャンセルが押された場合の処置
str = ""
End If
Set Shell = Nothing
Set myPath = Nothing
fncDialogFolder = str
End Function
Function BrowseFolder() As String
'**********************************************
'フォルダ選択ダイアログを表示し選択パスを返す
'**********************************************
Dim Shell
Set Shell = CreateObject("Shell.Application") _
.BrowseForFolder(&O0, "フォルダ選択", &H1 + &H10, 0)
If Shell Is Nothing Then
MsgBox "フォルダは選択されませんでした！", vbCritical
BrowseFolder = ""
Exit Function
Else
BrowseFolder = Shell.Items.Item.Path & "\"
End If
End Function
Private Sub test()
MsgBox BrowseFolder
End Sub
|
|