Skip to main content
1 / 2
Taku
  • 15
  • 2

フォルダを指定するダイアログを出して、選択したフォルダのファイルをすべて読み込む用に変更したら、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

`

Taku
  • 15
  • 2