У меня есть код для импорта HTML данных с веб-сайта.
Он работает для импорта данных до 94 строк Excel. После этого выдается ошибка
Слишком большая процедура VBA.
Я повторяю код, начинающийся с ieApp.Navigate "https://icms.indianrail.gov.in/reports/ReportServlet?reportAction=Utility&reportType=LocoCurrStatus&subAction=main
до End If
для каждой строки.
Как мне изменить код для более чем 600 строк? Sub GetTable ()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
'create a new instance of ie
Set ieApp = New InternetExplorer
'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://icms.indianrail.gov.in/reports/"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc.forms(0)
.UserId.Value = "88888"
.Password.Value = "******"
.submit
End With
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
ieApp.Navigate "https://icms.indianrail.gov.in/reports/ReportServlet?
reportAction=Utility&reportType=LocoCurrStatus&subAction=main"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'get the table based on the table’s id
Set ieDoc = ieApp.Document
With ieDoc.forms(0)
.trainNo.Value = Sheets("sheet1").Range("B2").Value
.startDate.Value = Format(Date - 1, "dd-mmm-yyyy")
.submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.Item("TABLE_6")
'copy the tables html to the clipboard and paste to teh sheet
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Sheet1.Select
Sheet1.Range("D2").Select
Sheet1.PasteSpecial "Unicode Text"
End If
End Sub
Мой лист Excel: