一部マクロを変更したいので教えてください。

現在、下記のようなマクロを使用しています。

Sub sample()
Dim myFile As String, myPath As String, i As Long
Application.ScreenUpdating = False
myPath = InputBox("フルパスでフォルダーを指定")
myFile = Dir(myPath & "\*.xls", vbNormal)
Do
Workbooks.Open myPath & "\" & myFile
For i = 1 To ActiveWorkbook.Sheets.Count
If WorksheetFunction.CountA(Sheets(i).Range("B7:B11")) = 0 Then
Sheets(i).Range("B7") = "*"
End If
Next
ActiveWorkbook.Close True
myFile = Dir()
Loop While myFile <> ""
Application.ScreenUpdating = True
MsgBox "完了 ！！"
End Sub

上から４行目のmyPath = InputBox("フルパスでフォルダーを指定")を
パスを入力するマクロではなくてもっと簡単にフォルダを選択するマクロに変更したいのですが
どうすればいいですか？

No.4 ベストアンサー 回答者： merlionXX 回答日時： 2011/04/26 16:48

Sub sample()

Dim myFile As String, myPath As String, i As Long
Dim myObj As Object
Application.ScreenUpdating = False
Set myObj = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myPath = IIf(myObj = "デスクトップ", CreateObject("WScript.Shell").SpecialFolders("Desktop"), myObj.Items.Item.Path)
myFile = Dir(myPath & "\*.xls", vbNormal)
' 以下おなじため略
End Sub

No.5 回答者： keithin 回答日時： 2011/04/26 18:34

ん？

sub macro1()
　dim myPath as string
　dim myFile as string
　dim w as worksheet

　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show = True Then
　　　application.screenupdating = false
　　　mypath = .selecteditems(1) & "\"
　　　myfile = dir(mypath & "*.xls")
　　　do until myfile = ""
　　　　workbooks.open filename:=mypath & myfile
　　　　for each w in activeworkbook.worksheets
　　　　　if application.counta(w.range("B7:B11"))=0 then
　　　　　　w.range("B7") = "*"
　　　　　end if
　　　　next
　　　　activeworkbook.close savechanges:=true
　　　　myfile = dir()
　　　loop
　　　application.screenupdating = true
　　　msgbox "Done"
　　End If
　End With
End Sub



＃他にも幾つか直してます。
　丸投げしないとできないなら最初からそう言ってください。

No.3 回答者： qualheart 回答日時： 2011/04/26 15:49

フォルダ参照を使えば良いと思いますよ。

Dim Shell
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")

キャンセルされた場合など、myPathが空だった場合の処理も必要になります。
If Not myPath Is Nothing Then
～

ご参考まで。

この回答への補足

マクロ初心者なので申し訳ないのですが、単純にその行をこれに変更すればよいと
いうわけではないですよね？
できれば、全体を添削していただけないでしょうか？

補足日時：2011/04/26 16:04

No.2 回答者： keithin 回答日時： 2011/04/26 15:46

＞もっと簡単にフォルダを選択するマクロに変更したい

お好きなやり方をどうぞ：
http://officetanaka.net/excel/vba/tips/tips39.htm


＃結果は簡単ですが,マクロはちょっと簡単じゃありませんね。

No.1 回答者： kmetu 回答日時： 2011/04/26 15:43

http://officetanaka.net/excel/vba/file/file02.htm

こちらを参考にしてください。