フォルダ選択ダイアログからフォルダをしてい

Question

こちらのコードは元々、マクロが入っているフォルダの中にある
ファイルの値を取得するコードなのですが、
ファイル選択ダイアログをだして、選んだフォルダの中にあるファイルから値を取得するように変えたいです。
このコードを使おうと思っています。
'フォルダを選択します。
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    'キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub

どのようにすると、うまくいきますか。
よろしくお願いします。

Dim wFile       As String
Dim wFilePath   As String
Dim i           As Long
 
'Excelファイルが存在していたらファイル名を返す
wFile = Dir(ActiveWorkbook.Path & "*.xlsx")
Sheets("単体テスト仕様書").Range("A2:D31").ClearContents
'先頭行を指定
i = 2
 
'カレントディレクトリに存在するExcelファイルを全て読み込む
Do While wFile <> ""
     
    '開くExcelファイルのフルパスを取得
    wFilePath = ActiveWorkbook.Path & "\" & wFile
     
    '機能（ﾌﾟﾛｸﾞﾗﾑ）名・テスト件数・完了数・不具合件数を取得し配列に格納する（区切り文字：|）
    strData = Split(File_Load(wFilePath), "|")
     
    '機能（ﾌﾟﾛｸﾞﾗﾑ）名
    Cells(i, 1) = strData(0)
     
    'テスト件数
    Cells(i, 2) = strData(1)
     
    '完了数
    Cells(i, 3) = strData(2)
    
    '不具合件数
    
    Cells(i, 4) = strData(3)
      
     
    '次のExcelファイルを取得
    wFile = Dir()
     
    '行数をカウント
    i = i + 1
 
Loop
 
    MsgBox "完了"
End Sub

Function File_Load(ByVal wFilePath As String) As String

    Dim wb          As Workbook
    Dim wItem       As Variant
    Dim i           As Long
    Dim FoundCell   As Object

    Set wb = Workbooks.Open(wFilePath)

    wItem = Array("作成者", "テスト件数", "完了数", "不具合件数")

    For i = LBound(wItem) To UBound(wItem)

        Set FoundCell = wb.Worksheets(1).Cells.Find(What:=wItem(i))

        If FoundCell Is Nothing Then
            wItem(i) = ""
        Else
            wItem(i) = FoundCell.Offset(1, 0).Value
        End If

    Next i

    wb.Close SaveChanges:=False

    File_Load = Join(wItem, "|")


End Function

Comments

[y_waiwai]

どういうふうにうまくいかないんでしょうか

[Gamagaeru]

こちらは、カレントディレクトリに存在するExcelファイルを全て読み込む処理になっていいるのですが、
フォルダ選択のダイアログをだして、選択したフォルダに入っているすべてのエクセルファイルを
読み込むようにしたいです。その際に、フォルダ選択のダイアログは出たのですが、そこに入っている、
すべてのファイルの読み取りがうまくいっていない状況です。

Answer 1

こんな感じでどうでしょうか。

    Dim wFile       As String
    Dim wFilePath   As String
    Dim i           As Long

    Dim dlg         As FileDialog
    Dim wSelFolder  As String

    'フォルダを選択します。
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    'キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub
    wSelFolder = dlg.SelectedItems(1)
    
    'Excelファイルが存在していたらファイル名を返す
    wFile = Dir(wSelFolder & "*.xlsx")
                  'ActiveWorkbook.Path を wSelFolder に変更 （以降も同様に）