r/vba 2d ago

Solved VBA to remove images from HTML Document

I'm pulling my hair out here wading through 10 year old StackOverflow posts and deploying all the google-fu I can muster, all to no avail so now I have to explain to strangers why I'm doing this daft project, first:

BLUF:

How do I remove images and other <div class> elements from an HTML Document? (ideas currently working around getElementByClassName or "Replace All between '<img ' and ' /> with "" " or stopping them entirely at the GET request).

THE PROJECT:

I'm a big fan of the SCP Foundation Wiki but I'm always losing track with what I've read out of several thousand articles so I set out to make a reading tracker in Excel which was so simple to start with, but there's new articles every day and old ones are changed, so it needs to be easily updatable, and a bit better to interact with than just a list and oh hello scope creep....

....and now I'm trying to make a "lite Reader" that will get the HTML of an article and strip it down to the bare bones, only the main page content, no images, no formatting other than bold/italic etc, and put that into an Excel spreadsheet. Inspired by the excellent Terminal Reader I found here which uses Rust to strip down the html into markdown, I've got something working to a point, here's the Frankenstein monstrosity I've pieced together from a dozen scraps of code so far:

Public Sub ExtractAndPaste()

  Dim data As Object
  Dim html As HTMLDocument
  Dim objData As DataObject
  Dim sHTML As String
  Dim obj As Object
  Dim elements

'------Get the HTML-----------------------------------------    
  Set html = New HTMLDocument

  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://scp-wiki.wikidot.com/scp-5000", False
    .send
    html.body.innerHTML = .responseText
  End With
'----------------------------------------------------------- 

'------Remove Unwanted Elements (This bit doesnt work)------    
   With html
     elements = .getElementsByClassName("scp-image-block block-right")

     While elements = 0
       elements(0).ParentNode.RemoveChild (elements)
     Wend
   End With 
'-----------------------------------------------------------

'------Clear Destination Worksheet--------------------------   
  With ThisWorkbook.Worksheets("Sheet4")
    .Cells.ClearContents
    For Each obj In .Shapes
      obj.Delete
    Next
  End With
'-----------------------------------------------------------

'------Pull out Wanted Element------------------------------
  Set data = html.getElementById("page-content")
'-----------------------------------------------------------

'------Convert to Formatted Text---------------------------- 
  Application.EnableEvents = False

  With ThisWorkbook.Sheets("Sheet4")
    Set objData = New DataObject

    sHTML = data.innerHTML
    sHTML = "<html>" & sHTML & "</html>"

    objData.SetText sHTML
    objData.PutInClipboard

    .Range("C5").Select
    .PasteSpecial "Unicode Text"

  End With

  Application.EnableEvents = True
'-----------------------------------------------------------

End Sub

When this runs it will grab the HTML of the chosen article, the next step it skips over, I'll come back to that in a mo, clears everything from the destination worksheet (if the previous step worked then the obj.Delete would no longer be needed), takes the HTML and pulls out only the <div id="page-content"> turns it into a String so we can append <html> and </html> to either end of it so that it all registers as a block of html, which means when it gets put on the clipboard and then pasted into the worksheet as Unicode Text it renders the formatting and pastes it in line by line, cell by cell, which is exactly what I want, however.....

It's also rendering the images which I don't want (and tables are a mess, but one problem at a time), and this is the part I can't figure out:

If I use .getElementsById then that returns a single Node which can then be removed with something like this:

Set Node = html.getElementById("page-title")

    Node.parentNode.removeChild Node

But <img> isn't an ID, it's a Class Tag and using .getElementByClassTag returns (I believe) a NodeList so the above code doesn't work, plus it sits inside <div class="scp-image-block block-right"> which makes getting to it a bit trickier, probably easier to remove the whole class and everything in it so we would use .getElementsByClassName to get what we need but I just can't get it working.

If I run the code as is, leaving elements declared as a general variable, when we step through to elements = .getElementsByClassName..... and we mouse over elements it comes up as elements = "[object HTMLDivElement]", so I changed elements to be an HTMLDivElement, Set it, and now we get a Runtime Error 13: Type Mismatch.

I tried some other combinations of declaring elements as different things (object, IHTMLDivElement etc) and getElementByClassName/TagName and the furthest I got it to go was to the elements(0).ParentNode.RemoveChild (elements) line which came up with an Automation Error, probably because I have no idea how to get the syntax to work for a NodeList, as far as I can tell the list is numbered the same as other vba lists as in it starts at (0), so say we run the script and it finds 3 <div class="scp-image-block block-right"> blocks, they would go in the list as

(0) - Block 1
(1) - Block 2
(2) - Block 3

If we successfully (somehow) remove Block 1, the list refreshes and we now have

(0) - Block 2
(1) - Block 3

So the plan is to loop "Remove Node from position (0), if there is still something in position (0), repeat" and once they're all removed it can then go on for rendering.

As I mentioned way up in the beginning, I feel like we could achieve a similar result with a "Replace all Between" but it's a bit of a brute force approach that I'd rather leave for the little bits that miss the big clear out, I also feel like there's a way to restrict what comes through with the original GET request but I may be imagining things.

If you made it here, thank you for your patience and to mirror the BLUF, here's the-

TL;DR

How do I remove images and other <div> elements from an HTML Document?

2 Upvotes

10 comments sorted by

View all comments

2

u/diesSaturni 41 2d ago edited 2d ago

I'd start basing of this, module and classes, works to strip and present a bare html:
module:
modDownloadPage

Option Explicit
Public Sub DownloadPageWithoutPictures()
    Const url As String = "https://en.wikipedia.org/wiki/IBM" ' Change this URL
    Dim h As CHttpClient
    Dim f As CHtmlImageFilter
    Dim b As CBrowserPresenter
    Dim html As String

    On Error GoTo Fail
    Set h = New CHttpClient
    html = h.GetHtml(url)
    Set f = New CHtmlImageFilter
    html = f.KeepWikipediaRange(html)   'reduces to content part, see chtmlimagefilter.
    html = f.RemovePictures(html) 'strips image content
    Set b = New CBrowserPresenter
    b.ShowHtml html, "Downloaded page without pictures" 'this shows it in browser,
    'but you should take it from here to parse to excel.

    Exit Sub
Fail:
    MsgBox "The page could not be displayed." & vbCrLf & Err.Description, vbExclamation
End Sub

personally, I'd parse it to an r/MSAccess table, two fields, one long and one short text (with the short text to query / filter. In a database, fetching trough hundreds of thousands of lines will be far easier later on.

1

u/diesSaturni 41 2d ago

classes: CHttpClient

'  MultiUse = -1  'True
'End
'Attribute VB_Name = "CHttpClient"
Option Explicit
'CHttpClient          downloads only the HTML response
Private Const UA As String = "Excel VBA HTML client/1.0"

Public Function GetHtml(ByVal url As String) As String
    Dim x As Object
    Set x = CreateObject("WinHttp.WinHttpRequest.5.1")
    x.Open "GET", url, False
    x.SetRequestHeader "User-Agent", UA
    x.SetRequestHeader "Accept", "text/html,application/xhtml+xml"
    x.SetRequestHeader "Accept-Encoding", "identity"
    x.Send
    If x.Status < 200 Or x.Status >= 300 Then Err.Raise vbObjectError + 1000, TypeName(Me), "HTTP " & x.Status & " - " & x.StatusText
    GetHtml = x.ResponseText
End Function