Скачивайте файлы с href и зацикливайте все файлы для сохранения на отдельных вкладках в книге на диске C - PullRequest
0 голосов
/ 21 апреля 2019

Попытка загрузки файлов из href и сохранение данных через цикл в отдельных вкладках в рабочей таблице на диске C.

Спасибо Тиму Уильямсу за помощь в написании кода до тех пор, пока я не скачаю файлы href. Но код ставить для копирования загруженных данных в Excel это не работает для меня.

Sub download()

    Dim ie As InternetExplorer
    Dim el As Object, els As Object

    Set ie = New InternetExplorer
    With ie
        .Visible = True
        .Navigate2 "http://www.nafed-india.com/Home/ProcDispoDetails"

        While .Busy Or .readyState < 4: DoEvents: Wend
    End With

    'Note: querySelectorAll unless you only want one element
    Set els = ie.document.querySelectorAll("a[href^='/Documents/ProcurementDisposal']")
    For Each el In els
        Debug.Print el.href 

    Dim i As Long

    Workbooks.Open Filename:="C:\Users\Desktop\Sample.xlsx"

    For i = 1 To ThisWorkbook.Sheets.Count
    Workbooks.Worksheets(i).Range("a1").Select
    ActiveCell.FormulaR1C1 = el.herf(i)
    Next i

    ActiveWorkbook.Save
    ActiveWindow.Close
        Next
End Sub

1 Ответ

1 голос
/ 21 апреля 2019

Попробуйте что-нибудь подобное.Настройтесь в соответствии с вашей конкретной ситуацией.

Sub download()

    Dim ie As InternetExplorer, i As Long
    Dim el As Object, els As Object, wb As Workbook, smpl as workbook

    Set smpl = Workbooks.Open(Filename:="C:\Users\Desktop\Sample.xlsx")

    Set ie = New InternetExplorer
    With ie
        .Visible = True
        .Navigate2 "http://www.nafed-india.com/Home/ProcDispoDetails"

        While .Busy Or .readyState < 4: DoEvents: Wend
    End With

    'Note: querySelectorAll unless you only want one element
    Set els = ie.document.querySelectorAll("a[href^='/Documents/ProcurementDisposal']")
    i = 1
    For Each el In els
        Debug.Print el.href 
        Set wb = Workbooks.Open(el.href)
        wb.sheets(1).Range("A1").CurrentRegion.Copy smpl.Sheets(i).Range("A1")
        wb.close false
        i = i +1
   Next el

   smpl.Save

End Sub

Примечание: вежливо принимать любые ответы, которые помогли вам - это помогает людям, которые приходят позже и смотрят на ваш вопрос, узнать, какие ответы сработали.Потратьте несколько минут, чтобы сделать это для ваших предыдущих сообщений - если вы пренебрегаете, что вы можете найти помощь иссякает ...

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...