vba过滤html代码,vba-废弃没有ID的HTML表-优快云博客

XHR:

您可以使用XHR完成整个工作,无需打开浏览器即可进行擦除。将ActiveSheet输出更改为要将表写入的工作表(

WriteTable hTable, 1, ActiveSheet

)。

注意,post主体的参数包括:

mm=12个月

aa=2017年

RUT=9278 RUT代码

代码:

Public Sub GetTable()

Dim sResponse As String, hTable As Object, id As String, lista() As String, rut As String

Dim strBody As String

id = Worksheets("Lista").Cells(2, 1).Value

lista = Split(id, "-")

rut = lista(0)

strBody = "mm=12&aa=2017&rut=" & rut

With CreateObject("MSXML2.XMLHTTP")

.Open "POST", "http://www.cmfchile.cl//institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27", False

.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.send strBody

sResponse = StrConv(.responseBody, vbUnicode)

End With

sResponse = Mid$(sResponse, InStr(1, sResponse, "))

With CreateObject("htmlFile")

.Write sResponse

Set hTable = .getElementsByTagName("table")(1)

End With

Application.ScreenUpdating = False

WriteTable hTable, 1, ActiveSheet

Application.ScreenUpdating = True

End Sub

Public Sub WriteTable(ByVal hTable As Object, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

If ws Is Nothing Then Set ws = ActiveSheet

Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object

R = startRow

With ws

Set tBody = hTable.getElementsByTagName("tbody")

For Each tSection In tBody 'HTMLTableSection

Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow

For Each tr In tRow

R = R + 1

Set tCell = tr.getElementsByTagName("td")

C = 1

For Each td In tCell 'DispHTMLElementCollection

.Cells(R, C).Value = td.innerText 'HTMLTableCell

C = C + 1

Next td

Next tr

Next tSection

End With

End Sub

使用浏览器(也使用上面的WriteTable Sub)

Option Explicit

Public Sub GetInfo()

Dim ie As New InternetExplorer, hTable As HTMLTable

Application.ScreenUpdating = False

With ie

.Visible = True

.navigate "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27"

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

.document.getElementById("aa").Value = 2017

.document.forms("consulta").submit

DoEvents

On Error Resume Next

Set hTable = .document.getElementsByTagName("table")(1)

On Error GoTo 0

Loop While hTable Is Nothing

WriteTable hTable, 1, ActiveSheet

End With

Application.ScreenUpdating = True

End Sub

输出:

参考文献:

通过vbe>工具>引用的HTML对象库

调整到代码大纲,但仍在使用

pestania = 27

Option Explicit

Public Sub GetInfo()

Dim ie As New InternetExplorer, hTable As HTMLTable, lista() As String, id As String, rut As String, enlace As String

Application.ScreenUpdating = False

id = Worksheets("Lista").Cells(2, 1).Value

lista = Split(id, "-")

rut = lista(0)

enlace = "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=" & rut & "&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw+cAAhAABP4MAAz&control=svs&pestania=27"

With ie

.Visible = True

.navigate enlace '"http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27"

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

.document.getElementById("aa").Value = 2017

.document.forms("consulta").submit

DoEvents

On Error Resume Next

Set hTable = .document.getElementsByTagName("table")(1)

On Error GoTo 0

Loop While hTable Is Nothing

WriteTable hTable, 1, ActiveSheet

End With

Application.ScreenUpdating = True

End Sub