VBA Получить ссылку на веб-страницу и загрузить файл на - PullRequest
Новая
       63

VBA Получить ссылку на веб-страницу и загрузить файл на

0 голосов
/ 03 ноября 2019

Давным-давно для программирования VBA. Я хочу получить в веб-таблице все связанные PDF-файлы в столбце (x). Сначала я создал логины и перешел на сайт для получения файла.
Таблица сайта:

enter image description here

Sub goToShopWH()

Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim clip As Object

'Table Grapping
Dim ieTable As Object

'create a new instance of ie
'Set ieApp = New InternetExplorer
Set ieApp = CreateObject("InternetExplorer.Application")

'you don’t need this, but it’s good for debugging
ieApp.Visible = True

'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "https://website.com/ishop/Home.html"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents:
Loop

' Login to site

Set ieDoc = ieApp.Document

'fill in the login form – View Source from your browser to get the control names
With ieDoc '.forms("loginForm_0")
 .getElementById("loginField").Value = "username"
 .getElementById("password").Value = "Password"
 .getElementById("loginSubmit").Click
  
 

Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop

'now that we’re in, go to the page we want
'Switsh to search form

ieApp.Navigate "https://website.com/ishop/account/MyAccount,$comp$account$AccountNavigation.orderHistory.sdirect?sp=Saccount%2FOrderHistory"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop

' fillout form

Set ieDoc = ieApp.Document
With ieDoc '.forms("Form_0")
 .getElementById("PropertySelection_2").Value = "7"
 .getElementById("commtxt").Value = "190055"  'Projekt Nummer oder Text.
 .getElementById("Submit_0").Click
  
End With


Do
DoEvents
Loop Until ieApp.ReadyState = 4

Application.Wait Now + TimeSerial(0, 0, 5)


With ieDoc '.forms("Form_1")
 .getElementById("PropertySelection").Value = "3"
 .getElementById("PropertySelection").FireEvent ("onchange")

End With

Do
DoEvents
Loop Until ieApp.ReadyState = 4
Application.Wait Now + TimeSerial(0, 0, 5)


End With

Set webpage = ieApp.Document

Set table_data = webpage.getElementsByTagName("tr")

End Sub

Пожалуйста, помогите решить эту проблему, чтобы получить Я хочу импортировать таблицу на лист2 и загрузить все PDF-файлы в ("Таблица"), ("tbody") (tr) (1)к X), (td) (10), (href) .click

1 Ответ

0 голосов
/ 04 ноября 2019

Я думаю, что вы после чего-то вроде этого. 

Sub webpage()

    Dim internet As Object
    Dim internetdata As Object
    Dim div_result As Object
    Dim header_links As Object
    Dim link As Object
    Dim URL As String

    Set internet = CreateObject("InternetExplorer.Application")
    internet.Visible = True

    URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
    internet.Navigate URL

    Do Until internet.ReadyState >= 4
        DoEvents
    Loop

    Application.Wait Now + TimeSerial(0, 0, 5)

    Set internetdata = internet.Document
    Set div_result = internetdata.getelementbyid("res")


    Set header_links = div_result.getelementsbytagname("h3")

    For Each h In header_links
        Set link = h.ChildNodes.Item(0)
        Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
    Next

    MsgBox "done"
End Sub

Или, может быть, это. 

' place your URL in cell L1
Sub HREF_Web()

Dim doc As HTMLDocument
Dim output As Object

Set IE = New InternetExplorer
IE.Visible = False
IE.navigate Range("L1")

Do
'DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Set doc = IE.document
Set output = doc.getElementsByTagName("a")

i = 5

For Each link In output
    'If link.InnerHTML = "" Then
        Range("A" & i).Value2 = link
   ' End If
   i = i + 1
Next

MsgBox "Done!"

End Sub
...