Can't write data in an excel file in a customized way - excel

Question

I'm trying to create a macro to fetch some content from a webpage and write the same in an excel file in a customized manner. I've used two identical links from the same website. Here is one of them. I'm interested in three fields Name,Recipe and Ingredients.
The script that I've created can parse the data accordingly. However, I wanna arrange them in an excel file like this.
I've written so far (working flawlessly):
Sub GetAndArrangeData()
Dim HTML As New HTMLDocument, oPost As Object
Dim HTMLDoc As New HTMLDocument, ws As Worksheet
Dim oTitle As Object, oPosts As Object
Dim linklist As Variant, url As Variant
linklist = Array( _
"https://www.chelseasmessyapron.com/avocado-chicken-salad-2/", _
"https://www.chelseasmessyapron.com/caprese-quinoa-salad/" _
)
Set ws = ThisWorkbook.Worksheets("Sheet1")
For Each url In linklist
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.104 Safari/537.36"
.send
HTML.body.innerHTML = .responseText
End With
Set oTitle = HTML.querySelector("h1.entry-title")
Debug.Print oTitle.innerText
Set oPost = HTML.querySelectorAll(".cma-recipe-nutrition > .wprm-nutrition-label-container > span[class*='nutrition-container']")
For I = 0 To oPost.Length - 1
HTMLDoc.body.innerHTML = oPost(I).outerHTML
Debug.Print HTMLDoc.querySelector("span.wprm-nutrition-label-text-nutrition-label").innerText
Debug.Print HTMLDoc.querySelector("span[class*='nutrition-value']").innerText
Next I
Set oPosts = HTML.querySelectorAll(".wprm-recipe-block-container")
For I = 0 To oPosts.Length - 1
HTMLDoc.body.innerHTML = oPosts(I).outerHTML
On Error Resume Next
Debug.Print HTMLDoc.querySelector("span.wprm-recipe-details-label").innerText
Debug.Print HTMLDoc.querySelector("span.wprm-recipe-details").innerText
On Error GoTo 0
Next I
Next url
End Sub
How can I write the data in an excel file the way I've shown in the image above?
Btw, this is the result I got in the immediate window:
Avocado Chicken Salad
Calories:
542
Carbohydrates:
30
Protein:
11
Fat:
45
Saturated Fat:
7
Cholesterol:
16
Sodium:
285
Potassium:
687
Fiber:
8
Sugar:
9
Vitamin A:
945
Vitamin C:
19
Calcium:
36
Iron:
1
Course
Cuisine
Keyword
Prep Time
20
Cook Time
15
Total Time
35
Servings
2
Calories
542
Cost
$6.82
Caprese Quinoa Salad
Calories:
375
Carbohydrates:
30
Protein:
11
Fat:
26
Saturated Fat:
4
Cholesterol:
7
Sodium:
73
Potassium:
996
Fiber:
9
Sugar:
7
Vitamin A:
17616
Vitamin C:
32
Calcium:
168
Iron:
4
Course
Cuisine
Keyword
Prep Time
35
Cook Time
25
Chilling Time (Quinoa)
1
Total Time
2
Servings
6
Calories
375
Cost
$6.84

Answer 1

Basically, you just need to keep track where to write the data. I define a variable row that is set to the first row where you want to put data into. After every recipe, the number of rows written is added to row. To keep track of the number of rows, I am using two separate variables oPostNut and oPostsRecipe(instead of only oneoPosts`) and add the number of entries of the larger list - that's basically all.
(...)
Dim row As Long
row = 1 ' Change to whatever row you want to start
For Each url In linklist
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.104 Safari/537.36"
.send
HTML.body.innerHTML = .responseText
End With
Set oTitle = HTML.querySelector("h1.entry-title")
ws.Cells(row, 1) = oTitle.innerText
Dim i As long
Dim oPostsNut As Object
Set oPostsNut = HTML.querySelectorAll(".cma-recipe-nutrition > .wprm-nutrition-label-container > span[class*='nutrition-container']")
For i = 0 To oPostsNut.Length - 1
HTMLDoc.body.innerHTML = oPostsNut(i).outerHTML
ws.Cells(row + i, 2) = HTMLDoc.querySelector("span.wprm-nutrition-label-text-nutrition-label").innerText
ws.Cells(row + i, 3) = HTMLDoc.querySelector("span[class*='nutrition-value']").innerText
Next i
Dim oPostsRecipe As Object
Set oPostsRecipe = HTML.querySelectorAll(".wprm-recipe-block-container")
For i = 0 To oPostsRecipe.Length - 1
HTMLDoc.body.innerHTML = oPostsRecipe(i).outerHTML
On Error Resume Next
ws.Cells(row + i, 4) = HTMLDoc.querySelector("span.wprm-recipe-details-label").innerText
ws.Cells(row + i, 5) = HTMLDoc.querySelector("span.wprm-recipe-details").innerText
On Error GoTo 0
Next i
row = row + IIf(oPostsNut.Length > oPostsRecipe.Length, oPostsNut.Length, oPostsRecipe.Length)
Next url

Answer 2

I think we can do better. If we use a more selective css selector we can get rid of the additional info that I am seeing in other answer (12/02/21) and your original attempt. Using the selector below I remove that additional info and only return desired info. I work with an array as is faster than writing to sheet all the time. I remove the need for re-creating xmlhttp object and the additional HTMLDocument.
Option Explicit
Public Sub GetAndArrangeData()
Dim html As New MSHTML.HTMLDocument, xhr As Object, ws As Worksheet
Dim linklist As Variant, url As Variant, totalRows
linklist = Array( _
"https://www.chelseasmessyapron.com/avocado-chicken-salad-2/", _
"https://www.chelseasmessyapron.com/caprese-quinoa-salad/" _
)
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set xhr = CreateObject("MSXML2.XMLHTTP")
totalRows = 1
For Each url In linklist
With xhr
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.104 Safari/537.36"
.send
html.body.innerHTML = .responseText
End With
Dim title As String
title = html.querySelector("h1.entry-title").innerText
Dim nutritionRows As Object, timesOtherRows As Object, maxRows As Long
Set nutritionRows = html.querySelectorAll(".wprm-nutrition-label-container .wprm-nutrition-label-text-nutrition-container")
Set timesOtherRows = html.querySelectorAll(".cma-recipe-mobile .wprm-recipe-times-container .wprm-recipe-block-container-columns, .wprm-recipe-meta-container ~ .wprm-recipe-block-container-columns")
maxRows = IIf(nutritionRows.Length > timesOtherRows.Length, nutritionRows.Length, timesOtherRows.Length) - 1
Dim recipeInfo(), i As Long
ReDim recipeInfo(1 To maxRows, 1 To 5)
On Error Resume Next
For i = 0 To maxRows
recipeInfo(i + 1, 1) = IIf(i = 0, title, vbNullString)
recipeInfo(i + 1, 2) = nutritionRows.Item(i).Children(0).innerText
recipeInfo(i + 1, 3) = nutritionRows.Item(i).Children(1).innerText
recipeInfo(i + 1, 4) = timesOtherRows.Item(i).Children(1).innerText
recipeInfo(i + 1, 5) = timesOtherRows.Item(i).Children(2).innerText
Next
On Error GoTo 0
ws.Cells(totalRows, 1).Resize(UBound(recipeInfo, 1), UBound(recipeInfo, 2)) = recipeInfo
totalRows = totalRows + maxRows
Next url
End Sub
JSON:
Perhaps easier though is to grab all the info as json from a script tag in the HEAD part of the response. You will need to wrap the response in body tags to prevent the HTML parser stripping this content out when you add it into the MSHTML.HTMLDocument object's body.innerHTML.
I am not going to show the json parsing as there are plenty of example but will show extracting it.
Option Explicit
Public Sub GetAndArrangeData()
Dim html As New MSHTML.HTMLDocument, xhr As Object
Dim linklist As Variant, url As Variant
linklist = Array( _
"https://www.chelseasmessyapron.com/avocado-chicken-salad-2/", _
"https://www.chelseasmessyapron.com/caprese-quinoa-salad/" _
)
Set xhr = CreateObject("MSXML2.XMLHTTP")
For Each url In linklist
With xhr
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.104 Safari/537.36"
.send
html.body.innerHTML = "<body>" & .responseText & "</body>"
End With
Debug.Print html.querySelector(".yoast-schema-graph").innerHTML
Next url
End Sub