Url as text

[klatlap]

This is part of a code i use to download data from a webpage, what i would like to add is the ability to download urls as text so i can then use the urls separately.

Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

    Dim HTMLTable As MSHTML.IHTMLElement
    Dim HTMLTables As IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    Dim HTMLCell As MSHTML.IHTMLElement
    Dim RowNum As Long, ColNum As Integer
    Dim sht As Worksheet
    Set HTMLTables = HTMLPage.getElementsByTagName("table")
    
    For Each HTMLTable In HTMLTables
        
    Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
        Range("A1").Value = HTMLTable.className
    
        RowNum = 2
        For Each HTMLRow In HTMLTable.getElementsByTagName("tr")
            
            ColNum = 1
            For Each HTMLCell In HTMLRow.Children
                Cells(RowNum, ColNum) = vbTab & HTMLCell.innerText
                ColNum = ColNum + 1
            Next HTMLCell
            
            RowNum = RowNum + 1
            
        Next HTMLRow
        
   Next HTMLTable
    
  
End Sub

 

[admiral100]

Hi,

Maybe something like that : (change range as needed)

Sub urlastext()
Dim hp As Hyperlink
Dim rng As Range
Dim ws As Worksheet
Set rng = Range("A1:A30")


For Each hp In rng.Hyperlinks
hp.Delete
Next


End Sub

 

[klatlap]

This solution works ok.

Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

    Dim HTMLTable As MSHTML.IHTMLElement
    Dim HTMLTables As IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    
    
    
    Set HTMLTables = HTMLPage.getElementsByTagName("table")
        
        For Each HTMLTable In HTMLTables
            Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = HTMLTable.className
             
            
                For Each HTMLRow In HTMLTable.getElementsByTagName("a")
                    Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = HTMLRow.getAttribute("href")
                
                Next HTMLRow
       
                  
        Next HTMLTable
    
   
End Sub

 

[klatlap]

Here is both codes for downloading URL's or can be changed to download other elements, make sure you go in to VBA editor Tools and References and reference the Microsoft XML Library, i am using Microsoft XML 6.0 as noted by the first Dim statement.

Option Explicit
Sub XML()
    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    
    
    XMLPage.Open "GET", "https://en.wikipedia.org/wiki/Main_Page", False
    XMLPage.send

    HTMLDoc.body.innerHTML = XMLPage.responseText
    
    ProcessHTMLPageURLlink HTMLDoc
End Sub

Sub ProcessHTMLPageURLlink(HTMLPage As MSHTML.HTMLDocument)

    Dim HTMLTable As MSHTML.IHTMLElement
    Dim HTMLTables As IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    
    
    
    Set HTMLTables = HTMLPage.getElementsByTagName("table")
        
        For Each HTMLTable In HTMLTables
            Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = HTMLTable.className
             
            
                For Each HTMLRow In HTMLTable.getElementsByTagName("a")
                    Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = HTMLRow.getAttribute("href")
                
                Next HTMLRow
       
                  
        Next HTMLTable
    
   
End Sub

This video was a great resource https://www.youtube.com/watch?v=dShR33CdlY8