エクセルマクロ フォルダの選択について

質問

いつもお世話になってます。
フォルダを選択して、その中にあるファイル名を読んで書き出すマクロを作りました。
そのプログラム一部を下記に示します。

Sub フォルダ選択()

Dim ff As Object
Set ff = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)
　・
　・
（読み出し、書き出し）
　・
　・
Q$ = MsgBox("次やりますか", vbYesNo)
If Q$ = "6" Then
Call フォルダ選択
End If

一応正常に動いているので問題はないのですが、少し改良を加えたいと思ってます。

１．冒頭に出てくる「フォルダ選択ウィンドウ」を画面の中央に表示させたい。
　　現状は画面の左上に出てきます。
２．続けて操作をするために「次やりますか」にYESで答えると、「フォルダ選択ウィンドウ」が再び現れますが、最上位のフォルダが表示されます。これを先ほど選んだフォルダを基準に次のフォルダを選ばせるように表示させたい。階層が非常に深い複数のフォルダを連続して操作するとすごく疲れますので。

こんなことできますか？

ご存知の方、よろしくお願い申し上げます。

なお、上記冒頭の構文はどこかに出ていたものをコピーさせて頂いたものなので、詳しい書式がわかりません。
よろしくお願いします。

回答No.9

Wendy02

KenKen_SPさん、こんばんは。
早速の対応、ありがとうございました。

私は、単純に、以下の部分だけに着目したので、
＞.hwndOwner = Application.hwnd

あまり深いことは考えていませんでしたが、
WH = GetForegroundWindow()
を、

　.hwndOwner =WH

で、GetForegroundWindow()が、アクティブなウィンドウのハンドルということで、コントロールの違いによって変わるかどうか、気がかりでしたので、
　HW =　GetForegroundWindow()
　myHwnd = FindWindow("ThunderDFrame", Caption)
　「myHwnd = FindWindow("XLMAIN", Application.Caption)」
とSPY++

で比較して、何度か違った方法で試してみましたが、特別、問題になる部分は出てきませんでした。

ただ、Application.hwndの場合と比較すると、ワークシートのClassのほうがハンドルされるようですが、ワークシートClass　であってもなくても、Excel内には違いありませんから、出てくるダイアログには関係ありませんね。

＞フォルダ参照ダイアログ」が表示されているにも関わらず、UserForm
＞を選択できてしまいます。

この件に関しては、Userform の場合は、そのコードの間だけ、Me.Hide　～　Me.Show 0としていればよさそうですね。しょせん、Excelの範疇の中ですからね（^^;

＞しかし、自信はありません（汗）
Excel 2000以上でしたら、私のほうから、保証させていただきます（^^;

こういうのは、ある程度知っていても、機会がないと、とってもやる気起こりません。ご質問者さん不在にして申し訳ないけれども、今回のご回答は、とても勉強させていただきました。

注意:Win32 APIを扱ったことがない方は、そのまま貼り付けすることをお勧めします。失敗すると、確実にOSレベルでハングします。

回答No.8

KenKen_SP

Wendy02さん、ありがとうございます。

ご指摘の点については、BrowseForFolder関数を下記のように修正させていただきます。これで、、Excel2000でも動きますか?

　　'ユーザーが操作中のウインドウハンドル取得
　　WH = GetForegroundWindow()
　　'BROWSEINFO構造体を用意
　　With typBrowserInfo
　　　　.hwndOwner = WH ' <-------------------------------- ここを修正
　　　　.pidlRoot = CSIDL_DESKTOP
　　　　.lpszTitle = strCaption
　　　　.ulFlags = BIF_RETURNONLYFSDIRS
　　　　.lpfn = FARPROC(AddressOf BrowseCallbackProc)
　　　　If Len(strPrevDir) Then
　　　　　　.lParam = strPrevDir
　　　　Else
　　　　　　.lParam = CurDir & vbNullChar '初期フォルダパス
　　　　End If
　　End With

FindWindow で XLMAIN 決め打ちだと UserForm から BrowseForDolder 関数がコールされた場合、「フォルダ参照ダイアログ」が表示されているにも関わらず、UserForm
を選択できてしまいます。
これでは、ちょっと都合が悪いので、ちょっと考えて見ました。

上記の GetForegroundWindow でウインドウハンドルを取得する方法だと UserForm から関数がコールされた場合でも対応できそうです。

しかし、自信はありません（汗）

回答No.7

Wendy02

KenKen_SP様、こんにちは。

参考ボタンを押させていただきました。

コードを試してみて、APIに、そういうのがあったのを思い出しました。やったことはあったけれども、すぐに忘れてしまうものでして(^^ゞ

#5 の
＞あと、言い忘れましたが #4 のコードは Excel2000 以上で動作します。コールバック関数の都合です。

ですが、これは、そのままですと、以下があるので、
＞.hwndOwner = Application.hwnd

Excel 2002 以上になってしまいますね。

Excel 2000 ですと、

もう1つAPI関数を加えて
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

BrowseForFolder関数に、

Dim hWnd　　　 As Long
hWnd = FindWindow("XLMAIN", Application.Caption)

'BROWSEINFOの構造体の代入に、
　 .hwndOwner = hWnd

とすればよいのですが、面倒なら、hWnd に、1200 を入れればよいですね。
（&H000004B0 =1200)

回答No.6

KenKen_SP

すみません、、寝ぼけてたみたいです。#4は多くのバグがありましたので、
撤回いたします。長くて申し訳ないのですが、バグフィックスしたものを
再アップしておきます。

'フォルダ参照ダイアログ表示
Option Explicit

'********************************************************************
'フォルダ参照ダイアログ表示用API
'********************************************************************
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
　　Alias "SHBrowseForFolderA" ( _
　　lpBROWSEINFO As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
　　Alias "SHGetPathFromIDListA" ( _
　　ByVal pidl As Long, ByVal pszPath As String) As Long

'BROWSEINFO構造体
Private Type BROWSEINFO
　　hwndOwner　　　As Long　 'Windowのハンドル
　　pidlRoot　　　 As Long　 'ルートフォルダ定数
　　pszDisplayName As String '選択フォルダ名
　　lpszTitle　　　As String 'ダイアログ表示メッセージ
　　ulFlags　　　　As Long　 'オプション
　　lpfn　　　　　 As Long　 'CallBack関数アドレス
　　lParam　　　　 As String 'CallBack関数パラメータ
　　iImage　　　　 As Long
End Type

'オプションフラグ(ulFlags)定数
Private Const CSIDL_DESKTOP = &H0　　　　'ルートフォルダをデスクトップに
Private Const BIF_RETURNONLYFSDIRS = &H1 '特殊フォルダを選択させない
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Const BFFM_INITIALIZED = 1

'********************************************************************
'UNC変換およびその他API
'********************************************************************
Private Declare Function WNetGetConnection Lib "mpr.dll" _
　　Alias "WNetGetConnectionA" ( _
　　ByVal lpszLocalName As String, ByVal lpszRemoteName As String, _
　　cbRemoteName As Long) As Long
Private Declare Function SendMessage Lib "user32" _
　　Alias "SendMessageA" ( _
　　ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
　　lParam As Any) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

'********************************************************************
'ダイアログ表示位置用API宣言
'********************************************************************
Private Declare Function MoveWindow Lib "user32" ( _
　　ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, _
　　ByVal nWidth As Long, ByVal nHeight As Long, _
　　ByVal bRepaint As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" _
　　Alias "SystemParametersInfoA" ( _
　　ByVal uAction As Long, ByVal uParam As Long, _
　　ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

'RECT構造体
Public Type RECT
　　Left　 As Long
　　Top　　As Long
　　Right　As Long
　　Bottom As Long
End Type
'モニターの有効なスクリーンサイズを取得
Private Const SPI_GETWORKAREA = 48

Public Function BrowseForFolder( _
　　Optional strCaption As String = "フォルダを指定して下さい", _
　　Optional UNC As Boolean = False) As String

　　Dim WH　　　　　　 As Long
　　Dim typBrowserInfo As BROWSEINFO
　　Dim lngRet　　　　 As Long
　　Dim strPath　　　　As String
　　Static strPrevDir　As String

　　'ユーザーが操作中のウインドウハンドル取得
　　WH = GetForegroundWindow()
　　'BROWSEINFO構造体を用意
　　With typBrowserInfo
　　　　.hwndOwner = Application.hwnd
　　　　.pidlRoot = CSIDL_DESKTOP
　　　　.lpszTitle = strCaption
　　　　.ulFlags = BIF_RETURNONLYFSDIRS
　　　　.lpfn = FARPROC(AddressOf BrowseCallbackProc)
　　　　If Len(strPrevDir) Then
　　　　　　.lParam = strPrevDir
　　　　Else
　　　　　　.lParam = CurDir & vbNullChar '初期フォルダパス
　　　　End If
　　End With
　　'フォルダの参照ダイアログ呼び出し
　　lngRet = SHBrowseForFolder(typBrowserInfo)
　　If lngRet Then
　　　　'予めNull文字をセット
　　　　strPath = String$(MAX_PATH, vbNullChar)
　　　　'フォルダパスを取得
　　　　SHGetPathFromIDList lngRet, strPath
　　　　BrowseForFolder = Left$(strPath, InStr(strPath, vbNullChar) - 1)
　　　　'UNC変換オプション
　　　　If UNC Then BrowseForFolder = ConvertUNC(BrowseForFolder)
　　　　'選択フォルダのパス記憶
　　　　strPrevDir = BrowseForFolder
　　　　'メモリ解放
　　　　CoTaskMemFree lngRet
　　Else
　　　　BrowseForFolder = vbNullString
　　End If

End Function

'AddressOf演算子ラッパー関数
Private Function FARPROC(pfn As Long) As Long
　　FARPROC = pfn
End Function

'コールバック関数（表示位置調整ほか）
Private Function BrowseCallbackProc( _
　　ByVal hwnd As Long, ByVal uMsg As Long, _
　　ByVal lParam As Long, ByVal lpData As Long) As Long

　　Dim typRect As RECT
　　Dim X As Long, Y As Long

　　'ダイアログサイズ定義
　　Const DlgW = 377
　　Const DlgH = 309

　　If uMsg = BFFM_INITIALIZED Then
　　　　'コールバックのBFFM_INITIALIZEDメッセージはウィンドウハンドルが返る
　　　　SendMessage hwnd, BFFM_SETSELECTIONA, 1, ByVal lpData
　　　　'スクリーンサイズ取得
　　　　Call SystemParametersInfo(SPI_GETWORKAREA, 0, typRect, 0)
　　　　'ダイアログ表示位置の移動
　　　　With typRect
　　　　　　X = (.Right / 2) - (DlgW / 2)
　　　　　　Y = (.Bottom / 2) - (DlgH / 2)
　　　　End With
　　　　Call MoveWindow(hwnd, X, Y, DlgW, DlgH, 0)
　　End If

End Function

'UNC変換関数
Private Function ConvertUNC(strPath As String)

　　Dim strDRV As String
　　Dim strBuf As String * MAX_PATH
　　Dim lngRet As Long

　　On Error GoTo ErrorHandler
　　'ドライブレター切り出し
　　strDRV = Left$(strPath, 2)
　　'UNC変換
　　lngRet = WNetGetConnection(strDRV, strBuf, MAX_PATH)
　　If lngRet = 0 Then
　　　　If InStr(1, strBuf, vbNullChar) > 1 Then
　　　　　　strPath = _
　　　　　　Left$(strBuf, InStr(1, strBuf, vbNullChar) - 1) _
　　　　　　& Mid$(strPath, 3)
　　　　End If
　　End If
　　ConvertUNC = strPath
　　Exit Function

ErrorHandler:
　　ConvertUNC = strPath
　　On Error GoTo 0
　　Exit Function
End Function

回答No.5

KenKen_SP

#4ですが、見直すと変数の宣言がもれたりしてますね。
すみません。

あと、言い忘れましたが #4 のコードは Excel2000 以上で動作します。コールバック関数の都合です。

回答No.4

KenKen_SP

こんばんは。長文ですみませんが、ご希望の条件を満たせたと思います。

API を使いまくってますので解説はできませんが、以下のマクロを標準
モジュールにコピー＆ペーストしてお使い下さい。

あと、オプションで UNC 変換機能を付加しています。UNC については
参考URLをご覧下さい。

【使い方】

Sub test()

　　Dim strPath As String

　　'フォルダ参照ダイアログ表示
　　'第1引数：（省略可）キャプション
　　'第2引数：（省略可）UNC変換オプション
　　strPath = BrowseForFolder(, True)

　　If strPath = vbNullString Then
　　　　MsgBox "キャンセルされました"
　　Else
　　　　MsgBox strPath
　　End If

End Sub

'以下フォルダ参照ダイアログ表示プロシージャ
'その他のプロシージャとは別の標準モジュールに単独で貼り付けて下さい。

'********************************************************************
'フォルダ参照ダイアログ表示用API
'********************************************************************
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
　　Alias "SHBrowseForFolderA" ( _
　　lpBROWSEINFO As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
　　Alias "SHGetPathFromIDListA" ( _
　　ByVal pidl As Long, ByVal pszPath As String) As Long

'BROWSEINFO構造体
Private Type BROWSEINFO
　　hwndOwner　　　As Long　 'Windowのハンドル
　　pidlRoot　　　 As Long　 'ルートフォルダ定数
　　pszDisplayName As String '選択フォルダ名
　　lpszTitle　　　As String 'ダイアログ表示メッセージ
　　ulFlags　　　　As Long　 'オプション
　　lpfn　　　　　 As Long　 'CallBack関数アドレス
　　lParam　　　　 As String 'CallBack関数パラメータ
　　iImage　　　　 As Long
End Type

'オプションフラグ(ulFlags)定数
Private Const CSIDL_DESKTOP = &H0　　　　'ルートフォルダをデスクトップに
Private Const BIF_RETURNONLYFSDIRS = &H1 '特殊フォルダを選択させない
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Const BFFM_INITIALIZED = 1

'********************************************************************
'UNC変換およびその他API
'********************************************************************
Private Declare Function WNetGetConnection Lib "mpr.dll" _
　　Alias "WNetGetConnectionA" ( _
　　ByVal lpszLocalName As String, ByVal lpszRemoteName As String, _
　　cbRemoteName As Long) As Long
Private Declare Function SendMessage Lib "user32" _
　　Alias "SendMessageA" ( _
　　ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
　　lParam As Any) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

'********************************************************************
'ダイアログ表示位置用API宣言
'********************************************************************
Private Declare Function MoveWindow Lib "user32" ( _
　　ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, _
　　ByVal nWidth As Long, ByVal nHeight As Long, _
　　ByVal bRepaint As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" _
　　Alias "SystemParametersInfoA" ( _
　　ByVal uAction As Long, ByVal uParam As Long, _
　　ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

'RECT構造体
Public Type RECT
　　Left　 As Long
　　Top　　As Long
　　Right　As Long
　　Bottom As Long
End Type
'モニターの有効なスクリーンサイズを取得
Private Const SPI_GETWORKAREA = 48

Public Function BrowseForFolder( _
　　Optional strCaption As String = "フォルダを指定して下さい", _
　　Optional UNC As Boolean = False) As String

　　Dim WH　　　　　　 As Long
　　Dim typBrowserInfo As BROWSEINFO
　　Dim lngRet　　　　 As Long
　　Dim strPath　　　　As String
　　Static strPrevDir　As String

　　'ユーザーが操作中のウインドウハンドル取得
　　WH = GetForegroundWindow()
　　'BROWSEINFO構造体を用意
　　With typBrowserInfo
　　　　.hwndOwner = Application.hwnd
　　　　.pidlRoot = CSIDL_DESKTOP
　　　　.lpszTitle = strCaption
　　　　.ulFlags = BIF_RETURNONLYFSDIRS
　　　　.lpfn = FARPROC(AddressOf BrowseCallbackProc)
　　　　If Len(strPrevDir) Then
　　　　　　.lParam = strPrevDir
　　　　Else
　　　　　　.lParam = CurDir & vbNullChar '初期フォルダパス
　　　　End If
　　End With
　　'フォルダの参照ダイアログ呼び出し
　　lngRet = SHBrowseForFolder(typBrowserInfo)
　　If lngRet Then
　　　　'予めNull文字をセット
　　　　strPath = String$(MAX_PATH, vbNullChar)
　　　　'フォルダパスを取得
　　　　SHGetPathFromIDList lngRet, strPath
　　　　BrowseForFolder = Left$(strPath, InStr(strPath, vbNullChar) - 1)
　　　　'UNC変換オプション
　　　　If UNC Then Broeseforfolder = ConvertUNC(BrowseForFolder)
　　　　'選択フォルダのパス記憶
　　　　strPrevDir = BrowseForFolder
　　　　'メモリ解放
　　　　CoTaskMemFree lngRet
　　Else
　　　　BrowseForFolder = vbNullString
　　End If

End Function

'AddressOf演算子ラッパー関数
Private Function FARPROC(pfn As Long) As Long
　　FARPROC = pfn
End Function

'コールバック関数（表示位置調整ほか）
Private Function BrowseCallbackProc( _
　　ByVal hwnd As Long, ByVal uMsg As Long, _
　　ByVal lParam As Long, ByVal lpData As Long) As Long

　　Dim typRect As RECT

　　'ダイアログサイズ定義
　　Const DlgW = 377
　　Const DlgH = 309

　　If uMsg = BFFM_INITIALIZED Then
　　　　'コールバックのBFFM_INITIALIZEDメッセージはウィンドウハンドルが返る
　　　　SendMessage hwnd, BFFM_SETSELECTIONA, 1, ByVal lpData
　　　　'スクリーンサイズ取得
　　　　Call SystemParametersInfo(SPI_GETWORKAREA, 0, typRect, 0)
　　　　'ダイアログ表示位置の移動
　　　　With typRect
　　　　　　x = (.Right / 2) - (DlgW / 2)
　　　　　　y = (.Bottom / 2) - (DlgH / 2)
　　　　End With
　　　　Call MoveWindow(hwnd, x, y, DlgW, DlgH, 0)
　　End If

End Function

'UNC変換関数
Private Function ConvertUNC(ByVal strPath As String)

　　Dim strDRV As String
　　Dim strBuf As String * MAX_PATH
　　Dim lngRet As Long

　　On Error GoTo ErrorHandler
　　'ドライブレター切り出し
　　strDRV = Left$(strFullPath, 2)
　　'UNC変換
　　lngRet = WNetGetConnection(strDRV, strBuf, MAX_PATH)
　　If lngRet Then
　　　　If InStr(1, strBuf, vbNullChar) > 1 Then
　　　　　　strPath = _
　　　　　　Left$(strBuf, InStr(1, strBuf, vbNullChar) - 1) _
　　　　　　& Mid$(strFullPath, 3)
　　　　End If
　　End If
　　ConvertUNC = strPath
　　Exit Function

ErrorHandler:
　　ConvertUNC = strPath
　　On Error GoTo 0
　　Exit Function
End Function

参考URL：

http://e-words.jp/w/UNC.html

回答No.3

Wendy02

後で考えてみましたが、

＞フォルダを選択して、その中にあるファイル名を読んで書き出すマクロを作りました。

＞("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)

これだけで、その目的は達成できないはすでずね。一体、どうやって実際のファイル名を取っているのでしょうか？

それから、Loop で取れば、別に、TempFolderなど必要はありませんでした。

'--------------------------------------
Sub test2()
　Dim myFname As Variant
　 Dim orgPath As String
　 orgPath = Application.DefaultFilePath
　 ChDir "C:\"
　Do
　 myFname = Application.GetOpenFilename("Excelファイル(*.xls),*.xls")
　 If VarType(myFname) = vbBoolean Then GoTo Endline
　'処理．．．
　'処理．．．
　Loop
Endline:
　 ChDir orgPath
End Sub
'--------------------------------------

#2 さんのコードを試して、それを参考にしてみました。（気を悪くしたら、すみません。）

No1の私の発言の
#特に、２番目のご質問は、あらかじめ、選べるRootFolderの定数名(49個)が決
#められているので、それ以外は無理だと思います。

この発言は、違っていたようですね。

CreateObject で、オートメーション・オブジェクトを作って、その後に、BrowseForFolderを作ると、数値(Numeric Value）のみのようでした。まさか、その都度、最初のオブジェクトを作るのは、ちょっと気が退けますので、以下のようにしてみました。（オートメーション・オブジェクトは、1回しか作らないはずだから、複数常駐することはないのですが。）

'--------------------------------------
Sub Test3()
　'要参照設定: Microsoft Shell Controls And Automation
　Dim objShell As Shell32.Shell
　Dim objFolder As Shell32.Folder
　Dim myPath As String
　myPath = "C:\"
　Set objShell = New Shell32.Shell
　Do
　Set objFolder = objShell.BrowseForFolder( _
　　　　　　0, "フォルダを選択してください", &H0, myPath)
　If objFolder Is Nothing Then GoTo EndLine
　If objFolder.Items.Item Is Nothing Then
　　myPath = objFolder.Self.Path
　　Else
　　myPath = objFolder.Items.Item.Path & "\"
　'？処理（どうやって、ファイル名を取るのかな？）
　End If
　Loop
EndLine:
　Set objFolder = Nothing
　Set objShell = Nothing
End Sub

'--------------------------------------
ただ、どんどん、掘り下げていくだけで、逆はできませんね。

参考:MSDNのBrowseForFolder

参考URL：

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browsefo

回答No.2

predater

次のプログラムで２回目は１回目に選んだフォルダが最初に表示されます。
CreateObjectの最後の引数に,ffを追加します。
ウィンドウの初期位置はわかりませんでした。（私のは最初から中央に表示されました）

Sub Macro1()
'
' Macro1 Macro
'
Dim ff As Object
x = 0
While (x < 2)
Set ff = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0, ff)
x = x + 1
Wend

'
End Sub

回答No.1

Wendy02

いろいろと考えてみましたが、

BrowseForFolder(lngHWND, strTitle, lngOptions, [RootFolder])

BrowseForFolderは、あくまでも、Windowsの外部ツールで、表現力が低いので、無理ではないかと思います。

特に、２番目のご質問は、あらかじめ、選べるRootFolderの定数名(49個)が決められているので、それ以外は無理だと思います。

通常、Excelの中から、ファイルを選ぶのでしたら、GetOpenFilename のダイアログを使うのだと思います。(2002なら、フォルダだけの選択は、FileDialogの msoFileDialogFolderPickerがあります。)

最初から、GetOpenFileName で、だいたいの目的の場所に、ChDir で行って、それで再び取得したフォルダ(以下でしたら、TempFolder) は、また、ChDir (TempFolder)で、使えばよいわけですね。

Sub test()
　Dim myFname As Variant
　 Dim orgPath As String
　 Dim TempFolder As String
　 orgPath = Application.DefaultFilePath
　 ChDir "C:\"
　 myFname = Application.GetOpenFilename("Excelファイル(*.xls),*.xls")
　TempFolder = Mid$(myFname, 1, InStrRev(myFname, "\") - 1)
　 If VarType(myFname) = vbBoolean Then Exit Sub
　'処理．．．
　'処理．．．

　 ChDir orgPath
End Sub

表示位置のほうは、設定はわかりません。
というか、APIを使うような気がしているのですが、これは考えたこともありません。

ただ、プライベートで使うのなら、ファイルを取捨選択するに、もっと簡単な方法は、

Dim myPath As String
myPath = ThisWorkbook.Path
ID = Shell("Explorer.exe /e, /root," & myPath, vbNormalFocus)
If ID = 0 Then Exit Sub

こんな風にして、エキスプローラを常に開けていけばよいです。
ドラッグして、Excelに置けば、そのファイルが開きます。
要らなくなったら、閉じればよいだけです。ただし、うっかりすれば、Excel以外のも開く危険性があります。