Sharid
Well-known Member
- Joined
- Apr 22, 2007
- Messages
- 1,066
- Office Version
- 2016
- Platform
- Windows
I need help on writing a loop for the Classes below in the code. I have being trying but I got stuck in a infinite loop and a loop that would only extract only the first prodoct over and over. I have removed all refferences to a loop so the code looks as clean as it can be. The code itself work, but does not loop for each item and I don't know how to write a loop.
Idealy I would not want the code changed as I undestand this code a lot better, I'm sure vba expert could write it a lot better. I did try to use Dim i As Long and then placed it in here, for ALL of the classes
Right now I would be happy with just a loop, I think it would be a FOR LOOP so For each item in doc.getElementsByClassName it would extract the data for each product and then move onto the next item. The number of products will be dynamic.
What the code does
It seaches a class. If there is NOTHING to extract it places a hyphen in the cell
Else
If there is data then it extracts it and places it in the cell
Currently I can extract the child element, as long as the (0).innerText is free and does not have an "i" in it as part of a loop e.g (i).innerText
None of my loops worked.
Thanks in advance
Idealy I would not want the code changed as I undestand this code a lot better, I'm sure vba expert could write it a lot better. I did try to use Dim i As Long and then placed it in here, for ALL of the classes
- Before = doc.getElementsByClassName("vip")(0).href
- After = doc.getElementsByClassName("vip")(i).href
Right now I would be happy with just a loop, I think it would be a FOR LOOP so For each item in doc.getElementsByClassName it would extract the data for each product and then move onto the next item. The number of products will be dynamic.
What the code does
It seaches a class. If there is NOTHING to extract it places a hyphen in the cell
VBA Code:
If doc.getElementsByClassName("lvtitle")(0) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"If there is data then it extracts it and places it in the cell
VBA Code:
dd = doc.getElementsByClassName("lvtitle")(0).innerText '.Children(1)
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = ddCurrently I can extract the child element, as long as the (0).innerText is free and does not have an "i" in it as part of a loop e.g (i).innerText
None of my loops worked.
VBA Code:
Private Sub CommandButton1_Click()
Dim IE As Object
Dim url As String
'Dim i As Long
Dim innerText As Variant
Dim HTMLDoc As Object
Dim doc As Object
Dim href As String
Dim lastrow As Long
Dim wsSheet As Worksheet
Dim dd As Variant
Dim wb As Workbook
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate2 Sheets("Sheet1").Range("A2").Value & Replace(Worksheets("Sheet1").Range("B2").Value, " ", "+")
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set doc = IE.document
While IE.readyState <> 4
Wend
End With
Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("Sheet1")
' I NEED A LOOP HERE FOR EACH doc.getElementsByClassName
'URL Link
If doc.getElementsByClassName("vip")(0) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
Else
dd = doc.getElementsByClassName("vip")(0).href 'innerText
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = dd
Cells.WrapText = False
End If
'Title
If doc.getElementsByClassName("lvtitle")(0) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
Else
dd = doc.getElementsByClassName("lvtitle")(0).innerText '.Children(1)
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd
Cells.WrapText = False
End If
'Amount Sold
If doc.getElementsByClassName("hotness-signal red")(0) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = "-"
Else
dd = doc.getElementsByClassName("hotness-signal red")(0).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1, "C").Value = dd
End If
'Current price
If doc.getElementsByClassName("prRange ")(i) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = "-"
Else
dd = doc.getElementsByClassName("prRange")(i).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row + 1, "D").Value = dd
End If
'Sub Title
If doc.getElementsByClassName("lvsubtitle")(i) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = "-"
Else
dd = doc.getElementsByClassName("lvsubtitle")(i).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row + 1, "E").Value = dd
End If
'Previous Price
If doc.getElementsByClassName("stk-thr")(i) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = "-"
Else
dd = doc.getElementsByClassName("stk-thr")(i).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "F").End(xlUp).Row + 1, "F").Value = dd
End If
'Shipping
If doc.getElementsByClassName("bfsp")(i) Is Nothing Then
wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = "-"
Else
dd = doc.getElementsByClassName("bfsp")(i).innerText
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "G").End(xlUp).Row + 1, "G").Value = dd
End If
IE.Quit
Set IE = Nothing
Set HTMLDoc = Nothing
Set nextPageElement = Nothing
Set div = Nothing
Set link = Nothing
MsgBox "All Done"
End SubThanks in advance
