フォルダを指定するダイアログを出して、選択したフォルダのファイルをすべて読み込む用に変更したら、400エラーが出てしまいました。

元々は、マクロが入っているフォルダの中にある、エクセルフォイルを読み込んで、
処理を進めていくプログラムだったのですが、自分で、任意のフォルダを選択して、
その中に、入っているすべてのファイルの値を取得できるように変えたら、400エラーが出てしまいました。
ご教授お願いいたします。

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

  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .Show
  folderPath = .SelectedItems(1)
  End With
 
'選択したフォルダに存在するExcelファイルを全て読み込む
Do While folderPath <> ""
     
    '開くExcelファイルのフルパスを取得
    wFilePath = ActiveWorkbook.Path & "\" & folderPath
     
    '機能（ﾌﾟﾛｸﾞﾗﾑ）名・テスト件数・完了数・不具合件数を取得し配列に格納する（区切り文字：|）
    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

行動規範の内容に同意します

回答1件

ベストアンサー

VBA
1Sub 単体テスト仕様書マクロ()
2Dim wFile       As String
3Dim wFilePath   As String
4Dim i           As Long
5
6Sheets("単体テスト仕様書").Range("A2:D31").ClearContents
7'先頭行を指定
8i = 2
9
10  Dim folderPath As Variant
11  With Application.FileDialog(msoFileDialogFolderPicker)
12  .Show
13  folderPath = .SelectedItems(1)
14  End With
15
16'Excelファイルが存在していたらファイル名を返す
17  wFile = Dir(folderPath & "*.xlsx")
18
19'選択したフォルダに存在するExcelファイルを全て読み込む
20Do While wFile <> ""
21
22    '開くExcelファイルのフルパスを取得
23    wFilePath = folderPath & "\" & wFile 
24
25    '機能（ﾌﾟﾛｸﾞﾗﾑ）名・テスト件数・完了数・不具合件数を取得し配列に格納する（区切り文字：|）
26    strData = Split(File_Load(wFilePath), "|")
27
28    '機能（ﾌﾟﾛｸﾞﾗﾑ）名
29    Cells(i, 1) = strData(0)
30
31    'テスト件数
32    Cells(i, 2) = strData(1)
33
34    '完了数
35    Cells(i, 3) = strData(2)
36
37    '不具合件数
38
39    Cells(i, 4) = strData(3)
40
41
42    '次のExcelファイルを取得
43    wFile = Dir()
44
45    '行数をカウント
46    i = i + 1
47
48Loop
49
50    MsgBox "完了"
51End Sub
52
53Function File_Load(ByVal wFilePath As String) As String
54
55    Dim wb          As Workbook
56    Dim wItem       As Variant
57    Dim i           As Long
58    Dim FoundCell   As Object
59
60    Set wb = Workbooks.Open(wFilePath)
61
62    wItem = Array("機能（ﾌﾟﾛｸﾞﾗﾑ）名", "テスト件数", "完了数", "不具合件数")
63
64    For i = LBound(wItem) To UBound(wItem)
65
66        Set FoundCell = wb.Worksheets(1).Cells.Find(What:=wItem(i))
67
68        If FoundCell Is Nothing Then
69            wItem(i) = ""
70        Else
71            wItem(i) = FoundCell.Offset(1, 0).Value
72        End If
73
74    Next i
75
76    wb.Close SaveChanges:=False
77
78    File_Load = Join(wItem, "|")
79
80
81End Function
82