I have the below code that will pull through data from a table on the first page of a website (Price, name, currency, change etc)
Public Sub GetTeamData()
Dim strWebAddress As String
Dim strH2AnchorContent As String
Dim IEDocument As MSHTML.HTMLDocument
Dim objH2 As MSHTML.HTMLHeaderElement
Dim obTable As MSHTML.HTMLTable
Dim objRow As MSHTML.HTMLTableRow
Dim objCell As MSHTML.HTMLTableCell
Dim lngRow As Long
Dim lngColumn As Long
' initialize some variables that should probably better be passed as paramaters or defined as constants
strWebAddress = "https://toolkit.financialexpress.net/santanderam"
dateNow = Now
bExitLoop = False
lngTimeoutInSeconds = 5
Do While Not bExitLoop
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Do
Loop
' open page
Set IEDocument = GetIEDocument(strWebAddress)
If IEDocument Is Nothing Then
MsgBox "Timeout reached opening this address:" & vbNewLine & strWebAddress, vbCritical
Exit Sub
End If
Dim ButtonData As Variant
Set ButtonData = IEDocument.getElementsByClassName("paginator fe-paging-navContainer")
Dim button As MSHTML.HTMLLinkElement
For Each button In ButtonData
Debug.Print button.nodeName
button.Click
' retrieve anchor element
Set oTable = IEDocument.getElementById("Price_1_1")
Debug.Print oTable.innerText
' iterate over the table and output its contents
lngRow = 1
For Each objRow In oTable.Rows
lngColumn = 1
For Each objCell In objRow.Cells
Cells(lngRow, lngColumn) = objCell.innerText
lngColumn = lngColumn + 1
Next objCell
lngRow = lngRow + 1
Next
Next button
End Sub
My problem is that I cannot get the data to pull through from the next pages (1..7).
Can anyone please help with why the above wont pull data through from the next pages?
Thank you!
After the bit of code that opens the page, replace the rest of the code with the below code. You might have to tweak it a bit but it should go through all available pages:
' Set the object for 'Next' button
Dim oNext As Variant
Set oNext = IEDocument.getElementsByClassName("ui-paging-button ui-state-default ui-corner-all ui-paging-next")
' Loop to go through all pages
Dim bExitMLoop As Boolean: bExitMLoop = False
lngRow = 1
Do While Not bExitMLoop
' Get data from current page
Set oTable = IEDocument.getElementById("Price_1_1")
For Each objRow In oTable.Rows
lngColumn = 1
For Each objCell In objRow.Cells
Cells(lngRow, lngColumn) = objCell.innerText
lngColumn = lngColumn + 1
Next objCell
lngRow = lngRow + 1
Next
' Check if Next button is available
If oNext.Length = 0 Then
bExitMLoop = True
Else
oNext.Item(0).Click
' Wait for page to refresh (could check the ready state here as well)
dateNow = Now
bExitLoop = False
lngTimeoutInSeconds = 3
Do While Not bExitLoop
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Do
Loop
' Reset 'Next' button object
Set oNext = Nothing
Set oNext = IEDocument.getElementsByClassName("ui-paging-button ui-state-default ui-corner-all ui-paging-next")
End If
Loop
Related
I would like to capture the full set of data within the table within
https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#
I was using the codes from the other post but I could only grab the first 10th data due to the page break.
Anyway I can amend the code in order to capture the full set of data pls?
Option Explicit
Public Sub MakeSelectionGetData()
Sheets("Sheet1").Cells.Clear
Dim ie As New InternetExplorer
Const url = "https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#"
Application.ScreenUpdating = False
With ie
.Visible = True
.navigate url
While .Busy Or .readyState < 4: DoEvents: Wend
Application.Wait Now + TimeSerial(0, 0, 6)
Dim nTable As HTMLTable
Set nTable = .document.getElementById("sblCapTable")
Dim Headers()
Headers = Array("Number", "Stock Code", "Real Time Available Volume for SBL Short Sales", "Last Modify")
Dim TR As Object, TD As Object, r As Long, c As Long
With ActiveSheet
r = 2
c = 1
Dim TR_col As Object, TD_col As Object
Set TR_col = nTable.getElementsByTagName("TR")
.Range("A1").Resize(1, UBound(Headers) + 1) = Headers
For Each TR In TR_col
Set TD_col = TR.getElementsByTagName("TD")
For Each TD In TD_col
.Cells(r, c) = TD.innerText
c = c + 1
Next
c = 1
r = r + 1
Next
End With
.Quit
End With
Application.ScreenUpdating = True
End Sub
It is advisable first of all to set the hits per page to 100. Then go through the pagination, which is a bit tricky on the page. I have commented on the macro:
Public Sub MakeSelectionGetData()
Const url = "https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#"
Dim ie As Object
Dim nodeDropdown As Object
Dim nTable As Object
Dim TR As Object
Dim TD As Object
Dim TR_col As Object
Dim TD_col As Object
Dim nodePagination As Object
Dim nodesCssCurrentNext As Object
Dim Headers() As Variant
Dim r As Long
Dim c As Long
Dim endOfPagination As Boolean
Sheets("Sheet1").Cells.Clear
Headers = Array("Number", "Stock Code", "Real Time Available Volume for SBL Short Sales", "Last Modify")
ActiveSheet.Range("A1").Resize(1, UBound(Headers) + 1) = Headers
r = 2
c = 1
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
Application.Wait Now + TimeSerial(0, 0, 6)
'Change hits per page to 100
'Get dropbox from html
On Error Resume Next
Set nodeDropdown = ie.document.getElementById("prePage")
On Error GoTo 0
'Select the entry with the value 100
nodeDropdown.selectedIndex = 3
'Trigger the change event to update the page
Call TriggerEvent(ie.document, nodeDropdown, "change")
'Short break to run the update
Application.Wait Now + TimeSerial(0, 0, 2)
'Loop through the pagination
Do
'Your code
Set nTable = ie.document.getElementById("sblCapTable").getElementsByTagName("tbody")(0)
Set TR_col = nTable.getElementsByTagName("TR")
For Each TR In TR_col
Set TD_col = TR.getElementsByTagName("TD")
For Each TD In TD_col
ActiveSheet.Cells(r, c) = TD.innerText
c = c + 1
Next TD
c = 1
r = r + 1
Next TR
'Click next button in pagination if it's a link
On Error Resume Next
Set nodePagination = ie.document.getElementById("Pagination")
On Error GoTo 0
'Check for no 'Next' button
Set nodesCssCurrentNext = nodePagination.getElementsByClassName("current next")
'While there is no element in the node collection we click the 'Next' button
If nodesCssCurrentNext.Length = 0 Then
'Click the 'Next' button
nodePagination.getElementsByClassName("next")(0).Click
'Short break to update the next 100 hits
'All data is in memmory, so there is nothing to load from the server
Application.Wait Now + TimeSerial(0, 0, 1)
Else
'If the node collection is not empty, we reached the end of pagination
endOfPagination = True
End If
Loop Until endOfPagination
ie.Quit
End Sub
This procedure to trigger the html event to change the dropdown to 100 hits per page:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub
I have made the macros script which retrieves the data from the URL. What I need is that, I need to increase the date one by one and get the data for each. the URL is like this :
https://www.ukdogracing.net/racecards/01-05-2017/monmore
Ia m able to get the data with this script :
Sub GetData()
Dim IE As Object
Dim doc As Object
Dim strURL As String
Dim I As Integer
For I = 1 To 5
strURL = "https://www.ukdogracing.net/racecards/01-05-2017/monmore" + Trim(Str(I))
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate strURL
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
Set doc = IE.Document
GetAllTables doc
.Quit
End With
Next I
End Sub
Sub GetAllTables(doc As Object)
Dim ws As Worksheet
Dim rng As Range
Dim tbl As Object
Dim rw As Object
Dim cl As Object
Dim tabno As Long
Dim nextrow As Long
Dim I As Long
Dim ThisLink As Object 'variable for <a> tags
Set ws = Worksheets.Add
For Each tbl In doc.getElementsByTagName("TABLE")
tabno = tabno + 1
nextrow = nextrow + 1
Set rng = ws.Range("B" & nextrow)
rng.Offset(, -1) = "Table " & tabno
For Each rw In tbl.Rows
For Each cl In rw.Cells
rng.Value = cl.outerText
Set rng = rng.Offset(, 1)
I = I + 1
Next cl
nextrow = nextrow + 1
Set rng = rng.Offset(1, -I)
I = 0
Next rw
Next tbl
I = Range("B" & Rows.Count).End(xlUp).Row 'last row with data
Do While Cells(I, 1).Value = "" 'will loop until first not blank found in column A (starting from last row of data, from end to start)
For Each ThisLink In doc.getElementsByTagName("a") 'we check all <a> tags
If ThisLink.innerText = Cells(I, 2).Value Then Cells(I, 1).Value = ThisLink.href 'If the innertext is the name of the race, in column A we add link
Next ThisLink
I = I - 1 'we decrease row position
Loop
End Sub
But I need the script takes the date part of the URL and add one day each time till today and get the data. for example :
https://www.ukdogracing.net/racecards/01-06-2017/monmore
https://www.ukdogracing.net/racecards/01-07-2017/monmore
etc... How can I make the script to get the data for each day adding one each time.
Thanks in advance.
Replace the first sub with this one and it will run for the specified dates. I couldn't see I having any purpose so i removed it.
Sub GetData()
Dim IE As Object, doc As Object
Dim strURL As String, myDate As Date
Set IE = CreateObject("InternetExplorer.Application")
With IE
For myDate = CDate("01-05-2017") To CDate("01-09-2017")
strURL = "https://www.ukdogracing.net/racecards/" & Format(myDate, "mm-dd-yyyy") & "/monmore" ' Trim(Str(I))
.navigate strURL
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
Set doc = IE.Document
GetAllTables doc
Next myDate
.Quit
End With
End Sub
I am doing IE automation using VBA (Basically I open IE and goto the specific URL from the sheet and then login using credentials from the sheet and then extract data from the webpage to excel) This has to happen for 20 websites so I added for loop and it works fine.
What I want is, in case of any error occurs with in the loop then loop has to restart.
I also tried "on error got 0, on error got -1" but it did not work.
Below is my Code - Kindly pardon me for poor coding I am new to VBA.
Sub Get_Data()
Sheets("Sheet2").Select
Range("E2").Select
Range("H6:H120").ClearContents
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
Dim E As Long
Dim S As Long
E = Range("A" & Rows.Count).End(xlUp).Row
JumpToHere:
For j = S To E
S = Range("H" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Select
Range("E" & S).Select
ActiveCell.Offset(1, -2).Select
Dim X As Variant
X = ActiveCell.Value
IE.navigate X
Do
If IE.ReadyState = 4 Then
IE.Visible = True
Exit Do
Else
DoEvents
End If
Loop
ActiveCell.Offset(0, 1).Select
Dim Y As Variant
Y = ActiveCell.Value
IE.document.all("username").Value = Y
ActiveCell.Offset(0, 1).Select
Dim Z As Variant
Z = ActiveCell.Value
IE.document.all("password").Value = Z
IE.document.all("merchant_login_submit_button").Click
Application.Wait (Now + TimeValue("0:00:8"))
Set ElementCol = IE.document.getElementsByTagName("span")
For Each link In ElementCol
If link.innerHTML = "Authentication Failed" Then
ActiveCell.Offset(0, 3).Value = "Authentication Failed"
GoTo JumpToHere
End If
Next
Set tags = IE.document.getElementsByTagName("input")
For Each tagx In tags
If tagx.Value = "Continue to Control Panel" Then
tagx.Click
Application.Wait (Now + TimeValue("0:00:3"))
Exit For
End If
Next
Set ElementCol = IE.document.getElementsByTagName("a")
For Each link In ElementCol
If link.innerHTML = "Reports" Then
link.Click
End If
Next
Application.Wait (Now + TimeValue("0:00:06"))
Dim checkdate As Integer
checkdate = Format(Date, "dd") - 1
IE.document.getElementById("snapshot_group_by").Value = "payment_processor"
IE.document.getElementById("snapshot_end_date_day").Value = checkdate
IE.document.all("reports_submit_button").Click
Application.Wait (Now + TimeValue("0:00:3"))
Dim ws As Worksheet
Dim rng As Range
Dim tbl As Object
Dim rw As Object
Dim cl As Object
Dim tabno As Long
Dim nextrow As Long
Dim I As Long
Set ws = Worksheets.Add
For Each tbl In IE.document.getElementsByTagName("TABLE")
tabno = tabno + 1
nextrow = nextrow + 1
Set rng = ws.Range("B" & nextrow)
rng.Offset(, -1) = "Table " & tabno
For Each rw In tbl.Rows
For Each cl In rw.Cells
rng.Value = cl.outerText
Set rng = rng.Offset(, 1)
I = I + 1
Next cl
nextrow = 0
Set rng = rng.Offset(1, -I)
I = 0
Next rw
Next tbl
ws.Cells.ClearFormats
Sheets("Sheet2").Select
ActiveCell.Offset(0, 3).Value = ActiveSheet.Previous.Range("F4")
Application.DisplayAlerts = False
ActiveSheet.Previous.Delete
Application.DisplayAlerts = True
Set ElementCol = IE.document.getElementsByTagName("a")
For Each link In ElementCol
If link.innerHTML = "Logout" Then
link.Click
End If
Next
Next j
End Sub
Sounds like your real problem is that your code isn't properly waiting. Instead of Application.Wait, use a proper waiting loop any time you invoke the IE.Navigate or any element .Click or form .Submit event.
VBA HTML not running on all computers
Otherwise, you don't have any active error-trapping in your code. Wrap your loop with On Error statements, as below.
The first one, On Error GoTo MyErrorHandler instructs the program of what to do if an error is encountered within the loop. If there's an error, the code underneath the MyErrorHandler label will execute, and resume at the NextJ label. Once the loop finishes, On Error GoTo 0 returns normal (i.e., none) error-handling. Any errors occurring outside the loop still raise an exception during runtime.
Option Explicit
Sub Get_Data()
'// Dim your variables
'// Executable code starts here
JumpToHere:
For j = S To E
On Error GoTo MyErrorHandler
' Now ANY ERROR, ANYWHERE in the loop will go to the error handler
NextJ:
Next j
'// Code below this line won't be subject to the error handler
On Error GoTo 0
'// more code if you have it
' Exit gracefully if there was no error:
Exit Sub
'// Here is the error handler:
MyErrorHandler:
Err.Clear()
Resume NextJ
End Sub
If you truly want to re-start the loop, then instead of NextJ, do Resume JumpToHere.
First of all I have read ALOT of different answers online in relation to this topic but I have to admit I am really struggling to adapt them to what I need so please any help is very much appreciated!
I need to extract the data listed on the following webpage (Pages 1-7) i.e. Fund Name, Price, Currency etc https://toolkit.financialexpress.net/santanderam and pull this data through to excel.
I have the below code that will open the IE page (which is working):
' return the document containg the DOM of the page strWebAddress
' returns Nothing if the timeout lngTimeoutInSeconds was reached
Public Function GetIEDocument(ByVal strWebAddress As String, Optional ByVal lngTimeoutInSeconds As Long = 15) As MSHTML.HTMLDocument
Dim IE As SHDocVw.InternetExplorer
Dim IEDocument As MSHTML.HTMLDocument
Dim dateNow As Date
' create an IE application, representing a tab
Set IE = New SHDocVw.InternetExplorer
' optionally make the application visible, though it will work perfectly fine in the background otherwise
IE.Visible = True
' open a webpage in the tab represented by IE and wait until the main request successfully finished
' times out after lngTimeoutInSeconds with a warning
IE.Navigate strWebAddress
dateNow = Now
Do While IE.Busy
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Function
Loop
' retrieve the webpage's content (that is, the HTML DOM) and wait until everything is loaded (images, etc.)
' times out after lngTimeoutInSeconds with a warning
Set IEDocument = IE.Document
dateNow = Now
Do While IEDocument.ReadyState <> "complete"
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Function
Loop
Set GetIEDocument = IEDocument
End Function
However I cannot find the table tag that contains all other tags that I am interested to allow the rest of the code to pull through the data, The below code is what I have so far:
Public Sub GetTeamData()
Dim strWebAddress As String
Dim strH2AnchorContent As String
Dim IEDocument As MSHTML.HTMLDocument
Dim objH2 As MSHTML.HTMLHeaderElement
Dim objTable As MSHTML.HTMLTable
Dim objRow As MSHTML.HTMLTableRow
Dim objCell As MSHTML.HTMLTableCell
Dim lngRow As Long
Dim lngColumn As Long
' initialize some variables that should probably better be passed as paramaters or defined as constants
strWebAddress = "https://toolkit.financialexpress.net/santanderam"
strH2AnchorContent = " "
' open page
Set IEDocument = GetIEDocument(strWebAddress)
If IEDocument Is Nothing Then
MsgBox "Timeout reached opening this address:" & vbNewLine & strWebAddress, vbCritical
Exit Sub
End If
' retrieve anchor element
For Each objH2 In IEDocument.getElementsByTagName("h2")
If objH2.innerText = strH2AnchorContent Then Exit For
Next objH2
If objH2 Is Nothing Then
MsgBox "Could not find """ & strH2AnchorContent & """ in DOM!", vbCritical
Exit Sub
End If
' traverse HTML tree to desired table element
' * move up one element in the hierarchy
' * skip two elements to proceed to the third (interjected each time with whitespace that is interpreted as an element of its own)
' * move down two elements n the hierarchy
Set objTable = objH2.parentElement _
.NextSibling.NextSibling _
.NextSibling.NextSibling _
.NextSibling.NextSibling _
.Children(0) _
.Children(0)
' iterate over the table and output its contents
lngRow = 1
For Each objRow In objTable.Rows
lngColumn = 1
For Each objCell In objRow.Cells
Cells(lngRow, lngColumn) = objCell.innerText
lngColumn = lngColumn + 1
Next objCell
lngRow = lngRow + 1
Next
End Sub
I am assuming if I can locate the correct table tag to enter in the line below:
strH2AnchorContent = " "
Then the above will work? If so can anyone help with finding the correct tag or advise where I am going wrong with the above?
Again any help would be REALLY appreciated!
Thanks
Edit 1
Updated code:
' open a webpage in the tab represented by IE and wait until the main request successfully finished
' times out after lngTimeoutInSeconds with a warning
IE.Navigate strWebAddress
dateNow = Now
Do While IE.Busy
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Function
Loop
' retrieve the webpage's content (that is, the HTML DOM) and wait until everything is loaded (images, etc.)
' times out after lngTimeoutInSeconds with a warning
Set IEDocument = IE.Document
dateNow = Now
Do While IEDocument.ReadyState <> "complete"
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Function
Loop
Set GetIEDocument = IEDocument
End Function
Public Sub GetTeamData()
Dim strWebAddress As String
Dim strH2AnchorContent As String
Dim IEDocument As MSHTML.HTMLDocument
Dim objH2 As MSHTML.HTMLHeaderElement
Dim obTable As MSHTML.HTMLTable
Dim objRow As MSHTML.HTMLTableRow
Dim objCell As MSHTML.HTMLTableCell
Dim lngRow As Long
Dim lngColumn As Long
' initialize some variables that should probably better be passed as paramaters or defined as constants
strWebAddress = "https://toolkit.financialexpress.net/santanderam"
' open page
Set IEDocument = GetIEDocument(strWebAddress)
If IEDocument Is Nothing Then
MsgBox "Timeout reached opening this address:" & vbNewLine & strWebAddress, vbCritical
Exit Sub
End If
' retrieve anchor element
Set oTable = IEDocument.getElementById("Price_1_1")
Debug.Print oTable.innerText
' iterate over the table and output its contents
lngRow = 1
For Each objRow In oTable.Rows
lngColumn = 1
For Each objCell In objRow.Cells
Cells(lngRow, lngColumn) = objCell.innerText
lngColumn = lngColumn + 1
Next objCell
lngRow = lngRow + 1
Next
End Sub
Your code is working fine, problem is that you are trying to capture data from the table before it is loaded. I added a simple Wait loop for 5 seconds and you current code captured the data. Below is the loop I added just before Set oTable = IEDocument.getElementById("Price_1_1") statement:
dateNow = Now
bExitLoop = False
lngTimeoutInSeconds = 5
Do While Not bExitLoop
If Now > DateAdd("s", lngTimeoutInSeconds, dateNow) Then Exit Do
Loop
Code above is a static 5 second wait. You could make it more dynamic.. I'll leave that there as a brain teaser :)
Iwant to get the href link from the following code:
<div class="border-content">
<div class="main-address">
<h2 class="address">
Marcos paz 2500<span></span>
</h2>
i tried using getelementsbytagname("a") but i don't know how to do that for the specific class "address". Any ideas?
Thanks Kilian, here's how i handle everything. Quite complicated but it worked, although it takes for ever as i have plenty of nested loops:
Sub Propiedades()
'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer
'to refer to the HTML document returned
Dim html As HTMLDocument
'open Internet Explorer in memory, and go to website
Set ie = New InternetExplorer
ie.Visible = False
ie.Navigate "http://www.argenprop.com/Departamentos-tipo-casa-Venta-Almagro-Belgrano-Capital-Federal/piQ86000KpsQ115000KmQ2KrbQ1KpQ1KprQ2KpaQ135Kaf_816Kaf_100000001KvnQVistaResultadosKaf_500000001Kaf_801KvncQVistaGrillaKaf_800000002Kaf_800000005Kaf_800000010Kaf_800000041Kaf_800000011Kaf_800000020Kaf_800000030Kaf_800000035Kaf_800000039Kaf_900000001Kaf_900000002Kaf_900000006Kaf_900000008Kaf_900000009Kaf_900000007Kaf_900000010Kaf_900000033Kaf_900000034Kaf_900000036Kaf_900000038Kaf_900000037Kaf_900000035Kaf_900000039Kaf_900000041Kaf_900000042Kaf_900000043"
'Wait until IE is done loading page
Do While ie.ReadyState <> READYSTATE_COMPLETE
Application.StatusBar = "Trying to go to argenprop ..."
DoEvents
Loop
'show text of HTML document returned
Set html = ie.Document
'close down IE and reset status bar
Set ie = Nothing
Application.StatusBar = ""
'clear old data out and put titles in
Sheets(2).Select
Cells.ClearContents
'put heading across the top of row 3
Range("A3").Value = "Direccion"
Range("B3").Value = "Mts cuadrados"
Range("C3").Value = "Antiguedad"
Range("D3").Value = "Precio"
Range("E3").Value = "Dormitorios"
Range("F3").Value = "Descripcion"
Range("G3").Value = "Link"
Dim PropertyList As IHTMLElement
Dim Properties As IHTMLElementCollection
Dim Property As IHTMLElement
Dim RowNumber As Long
Dim PropertyFields As IHTMLElementCollection
Dim PropertyField As IHTMLElement
Dim PropertyFieldLinks As IHTMLElementCollection
Dim caracteristicasfields As IHTMLElementCollection
Dim caract As IHTMLElement
Dim caracteristicas As IHTMLElementCollection
Dim caractfield As IHTMLElement
Set PropertyList = html.getElementById("resultadoBusqueda")
Set Properties = PropertyList.Children
RowNumber = 4
For Each Property In Properties
If Property.className = "box-avisos-listado clearfix" Then
Set PropertiesFields = Property.all
For Each PropertyField In PropertiesFields
Fede = PropertyField.className
If PropertyField.className Like "avisoitem*" Then
Set caracteristicas = PropertyField.Children
For Each caract In caracteristicas
f = caract.className
If f = "border-content" Then
Set caracteristicasfields = caract.all
For Each caractfield In caracteristicasfields
test1 = caractfield.className
u = caractfield.innerText
If caractfield.className <> "" Then
Select Case caractfield.className
Case Is = "address"
Cells(RowNumber, "A") = caractfield.innerText
marray = Split(caractfield.outerHTML, Chr(34))
Cells(RowNumber, "G") = "www.argenprop.com" & marray(5)
Case Is = "list-price"
Cells(RowNumber, "D") = caractfield.innerText
Case Is = "subtitle"
Cells(RowNumber, "F") = caractfield.innerText 'descripcion
'Case is ="datoscomunes"
'Set myelements = caractfield.all
Case Is = "datocomun-valor-abbr"
Select Case counter
Case Is = 0
Cells(RowNumber, "B") = caractfield.innerText 'square mts
counter = counter + 1
Case Is = 1
Cells(RowNumber, "E") = caractfield.innerText 'DORMITORIOS
counter = counter + 1
Case Is = 2
Cells(RowNumber, "C") = caractfield.innerText ' antiguedad
counter = 0 ' reset counter
Set caracteristicasfields = Nothing
Exit For 'salgo del loop en caractfield
End Select 'cierro el select del counter
End Select 'cierro el select de caractfield.classname
End If ' cierro If caractfield.className <> "" Then
Next caractfield
End If ' cierro el border content
If caract = "border-content" Then Exit For 'salgo del loop dentro de aviso item (caract)
Next caract
RowNumber = RowNumber + 1
End If ' If PropertyField.className Like "avisoitem*"
Next PropertyField 'para ir al siguiente aviso
End If
Next Property
Set html = Nothing
MsgBox "done!"
End Sub