Как получить данные о каждой загруженной книге?

Question

поэтому у меня есть следующий макрос, который загружает несколько рабочих книг с веб-страницы компании. Теперь я хочу извлечь данные из каждой рабочей книги, поэтому во время каждого l oop, прежде чем перейти к загрузке следующей рабочей книги. Как я могу это сделать ? РЕДАКТИРОВАТЬ: На самом деле это не имеет значения, если я сначала загрузить все файлы, а затем получить данные или получить данные каждого файла в своем собственном l oop.

Sub Downloaden_Reviews()


Dim dlURL As String
Dim i As Range
Dim versch As String
Dim ordner As String

'Select Saving path
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select where to save"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath

If .Show = -1 Then
ordner = .SelectedItems(1)
End If
End With
'Ende order

Application.ScreenUpdating = False

For Each i In ActiveSheet.Range("B1:B100")
If i = "" Then
End
End If

versch = i.Offset(0, -1)
dlURL = "URL of the webpage"

Dim HttpReq As Object
Set HttpReq = CreateObject("Microsoft.XMLHTTP")

HttpReq.Open "GET", dlURL, False
HttpReq.send

dlURL = HttpReq.responseBody
If HttpReq.Status = 200 Then
    Set oStrm = CreateObject("ADODB.Stream")
    oStrm.Open
    oStrm.Type = 1
    oStrm.Write HttpReq.responseBody
    oStrm.SaveToFile [ordner] & "\" & [i] & ".xlsm", 1 ' 1 = no overwrite, 2 = overwrite"
    oStrm.Close
End If
Next

Answer 1

Я нашел следующий код. Работает для моего случая.

Sub Aus_allen()
    Dim strDatei As String, strPfad As String, strTyp As String
    Dim wbX As Workbook, wksX As Worksheet, wksN As Worksheet
    Dim lngCount As Long
    Application.ScreenUpdating = False
    strPfad = "C:\Users\p\MakroTest\"                 'Pfad anpassen
    strTyp = "xlsm"                      'Dareityp anpassen
    Set wksN = ThisWorkbook.Sheets("Tabelle1")   'Zieltabelle
    strDatei = Dir(strPfad & "\*." & strTyp)
    Do Until strDatei = ""
        Set wbX = Workbooks.Open(strPfad & "\" & strDatei)
        Set wksX = wbX.Sheets(1)
        wksN.Cells(8, 5) = wksX.Cells(8, 5)
        wbX.Close False
        strDatei = Dir
    Loop
    Application.ScreenUpdating = True
End Sub