'フォルダ名を取得する関数(GetOpenFilename)

Function GetFolder() As String
    Dim sDir As String
    Dim sOldDir As String
    Dim vRet As Variant
    sOldDir = CurDir()
    MsgBox "フォルダを開いた後、[開く]または[キャンセル]を押してください。", vbInformation, "フォルダの選択"
    vRet = Application.GetOpenFilename
    sDir = CurDir()
    ChDrive sOldDir
    ChDir sOldDir
    If MsgBox(sDir & " が選択されました。", _
            vbOKCancel Or vbInformation, "フォルダの選択") = vbOK Then
        GetFolder = sDir
    Else
        GetFolder = ""
    End If
End Function

Sub Test()
    Dim sDir As String
    sDir = GetFolder()
    If sDir = "" Then
        MsgBox "キャンセルされました。", vbExclamation
    Else
        MsgBox sDir
    End If
End Sub