首页 > 解决方案 > 如何获取每个下载的 Workbook 的数据?

问题描述

所以我有以下宏,它从公司网页下载几个工作簿。现在我想从每个工作簿中提取数据,所以在每个循环期间,在移动到下一个工作簿的下载之前。我怎么做 ?编辑:实际上,如果我先下载所有文件然后获取数据或在其自己的循环中获取每个文件的数据,这并不重要。

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

标签: excelvbaserver

解决方案


我找到了以下代码。适用于我的情况。

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


推荐阅读