フォルダ選択 - shikaku's blog

[vbs][wsh]
'-----------------------------
'デスクトップのパスを取得
'-----------------------------
Public Const CNST_STR_DESKTOP = "Desktop"
Dim s_DesktopPath
Set objWShell = CreateObject("WScript.Shell")
s_DesktopPath = objWShell.SpecialFolders(CNST_STR_DESKTOP)
Set objWShell = Nothing

'--------------------------------------
'フォルダを指定
'--------------------------------------
Dim objShell    ' Shell オブジェクト
Dim objFolder   ' フォルダ情報

Const BIF_RETURNONLYFSDIRS = &H1

Dim InputdataPath

Set objShell = WScript.CreateObject("Shell.Application")
If Err.Number = 0 Then
    Set objFolder = objShell.BrowseForFolder(0, "データフォルダを選択して下さい", BIF_RETURNONLYFSDIRS)
    If Not objFolder Is Nothing Then
        Select Case objFolder
            Case "デスクトップ"
                'Shell.BrowseForFolder でデスクトップを選択した場合
                ' .Items.Item.Path ではErr.Number = 91 が発生するため
                InputdataPath = s_DesktopPath
            Case Else
                InputdataPath = objFolder.Items.Item.Path
        End Select

        'WScript.Echo objFolder.Items.Item.Path
    End If

    'Set objFolder = objShell.BrowseForFolder(0, "Ｃドライブ", 0, "C:\")
    'If Not objFolder Is Nothing Then
    '    WScript.Echo objFolder.Items.Item.Path
    'End If

    'Set objFolder = objShell.BrowseForFolder(0, "スタートメニュー", 0, &HB)
    'If Not objFolder Is Nothing Then
    '    WScript.Echo objFolder.Items.Item.Path
    'End If
Else
    'WScript.Echo "エラー：" & Err.Description
	MsgBox "エラー：" & Err.Description
End If
ネタ元