Sub TVDBEpisodeGetter()
ActiveSheet.UsedRange.ClearContents
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
XMLPage.Open "GET", "https://www.thetvdb.com/series/family-guy/seasons/all", False
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText
ProcessHTMLPage HTMLDoc
'I think excel does this on its own, but I added these lines to close the instances
Set XMLPage = Nothing
Set HTMLDoc = Nothing
End Sub
Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)
'Grabs every Html row (includes the episodes from every season)
Dim HTMLRow As MSHTML.IHTMLElement
'Accesses each element within the Table Row
Dim HTMLCell As MSHTML.IHTMLElement
'Stores the Elements tagged as H3 headers (usually the season titles)
Dim HTMLSeasons As MSHTML.IHTMLElementCollection
Dim HTMLSeason As MSHTML.IHTMLElement
'Tracks active position on sheet (where next data is headed)
Dim RowNum As Long, ColNum As Integer
'Array to store all the season titles
Dim seasonHeader() As String
Dim currentSeason As Integer: currentSeason = 1
'Iterator for building seasons array // initialize to 1
Dim i As Integer: i = 1
'Since we want to start at 0 IF there is a specials category,
'I made this counter to subtract from the season number if necessary
Dim specialsCount As Integer: specialsCount = 0
'Finds the start and end positions of the HTML Code snippet that is english
Dim englishFindIndex As Integer
Dim endOfEnglishIndex As Integer
'Going to extract the number from Season header (2015, 3, etc...)
Dim currentSeasonNumber() As String
'Read all the Season Titles
Set HTMLSeasons = HTMLPage.getElementsByTagName("h3")
'Prepare an array to hold the titles
ReDim seasonHeader(1 To HTMLSeasons.Length)
'Iterate through all season titles and store them to array
For Each HTMLSeason In HTMLSeasons
seasonHeader(i) = HTMLSeason.innerText
i = i + 1
Next HTMLSeason
'Initialize active position on sheet
RowNum = 1
'Process one row at a time (episodes or season headers)
For Each HTMLRow In HTMLPage.getElementsByTagName("tr")
'Start on Left
ColNum = 1
'In current row, access each entry 1-at-a-time
For Each HTMLCell In HTMLRow.Children
'Check to see if we are on a subheader
If InStr(1, HTMLCell.innerText, "#") > 0 Then
'If we are, we are going to slide the Season title in before adding the subheader.
'This will generate the correct header
Select Case seasonHeader(currentSeason)
'If the category is named "specials" use that name and increment specialsCount
Case "Specials"
Cells(RowNum, ColNum) = "Specials"
specialsCount = specialsCount + 1
'This is the case for any title of the form [Season #]
'If something is getting labeled like this that shouldnt be... youll need to add another case
'with "specialsCount" to handle it
Case Else
' Cells(RowNum, ColNum) = "Season " & (currentSeason - specialsCount)
Cells(RowNum, ColNum) = seasonHeader(currentSeason)
End Select
'Since we just used the label, make sure to move to next row and increment the season number
RowNum = RowNum + 1
currentSeason = currentSeason + 1
End If
'Adds Season Prefix to Episode Number (ripped from header)
If ColNum = 1 And Not InStr(1, HTMLCell.innerText, "#") > 0 Then
'Looks for a space, and then grabs whatever is in the second part of the name
If InStr(1, seasonHeader(currentSeason - 1), " ") > 0 Then
currentSeasonNumber = Split(seasonHeader(currentSeason - 1))
Cells(RowNum, ColNum) = currentSeasonNumber(1) & "x" & HTMLCell.innerText
'Should just be the case for Specials
Else
'Edit this to change the prefix for specials
Cells(RowNum, ColNum) = (currentSeason - 1 - specialsCount) & "x" & HTMLCell.innerText
End If
Else
'Debug.Print HTMLCell.innerText
If InStr(1, HTMLCell.innerHTML, "data-language=""en""") > 0 Then
'finding start and end position of string that will look like this:
' data-language="en">Inside Look
englishFindIndex = InStr(1, HTMLCell.innerHTML, "data-language=""en""") + 19
endOfEnglishIndex = InStr(englishFindIndex, HTMLCell.innerHTML, "<")
'Write properly formatted (english only) title to cell
Cells(RowNum, ColNum) = Mid(HTMLCell.innerHTML, englishFindIndex, endOfEnglishIndex - englishFindIndex)
Else
'No language issue, just write to cell in original format
Cells(RowNum, ColNum) = HTMLCell.innerText
End If
End If
'Done with current HTML-cell, move to next sheet-column
ColNum = ColNum + 1
'Move to next HTML-Cell
Next HTMLCell
'Done with current HTML-row, move to next sheet-row
RowNum = RowNum + 1
'Move to next HTML-row
Next HTMLRow
'Format Sheet (AutoFit) to display all text
ActiveSheet.UsedRange.Columns.AutoFit
ActiveSheet.UsedRange.Rows.AutoFit
End Sub
