VBAで400エラーが出てしまいます

Question

以下のコードを実行すると400エラーが出てしまいます。
どのようにしたら、正常に値が取得できるでしょうか。
宜しくお願いします。

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


'Excelファイルを開いてデータを取得
'戻り値：名前|住所　（ | で区切る）
Function File_Load(ByVal wFilePath As String) As String
 
Dim CurBookName As Variant
Dim ColNo       As Long
Dim RowNo       As Long
Dim strValue    As String
Dim FoundCell   As Range
Dim i           As Long


'ファイルを開く
Workbooks.Open wFilePath


 
'開いたExcelのファイル名を取得
CurBookName = Application.ActiveWorkbook.Name
 
'検索する項目を配列に格納
wItem = Array("機能（ﾌﾟﾛｸﾞﾗﾑ）名", "テスト件数", "完了数", "不具合件数")
 
 
'検索する
For i = LBound(wItem) To UBound(wItem)
    Set FoundCell = Cells.Find(What:=wItem(i))
    If FoundCell Is Nothing Then
        '検索出来なかった場合
        If i = 0 Then
            strValue = ""
        Else
            strValue = strValue & "|"
        End If
    Else
        '検索したセルに移動
        FoundCell.Select
        ColNo = ActiveCell.Column   '列番号を取得
        RowNo = ActiveCell.Row      '行番号を取得
        '機能（ﾌﾟﾛｸﾞﾗﾑ）名を取得
        If i = 0 Then
            '最初の項目
           Cells(15, 3).Value
           Cells(16, 3).Value
           Cells(18, 3).Value
           
        Else
            '2番目以降の項目は|で区切る
            strValue = strValue & "|" & Cells(RowNo, ColNo + 1).Value
        End If
    
    End If
    
Next i


 
'結果を返す
File_Load = strValue


     
'開いたExcelファイルを閉じる
Application.DisplayAlerts = False   '確認メッセージの非表示
Workbooks(CurBookName).Close
Application.DisplayAlerts = True    '確認メッセージの表示

MsgBox "完了"


 
End Function

Answer 1

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).Value
        End If

    Next i
    
    wb.Close SaveChanges:=False

    File_Load = Join(wItem, "|")

    MsgBox "完了"

End Function

Comments

[Gamagaeru]

ありがとうございます。
400エラーはなくなりました。