Thread: Extract Data from Web Page Source Code

Hello R1chard,

Welcome to the Forum!

Yes the data can be extracted from the between the tags. My question is why is the page source in the workbook? Surely, you don't need to save the entire page source do you?

Hello R1chard,

Sorry about the delay. I have been experiencing system problems for the past 2 days and everything has been unstable. None of my diagnostics has been able to pin point the problem. I finally got some code together for you despite these problems.

The attached workbook contains 5 macros in 3 separate modules. This code works much faster than using Internet Explorer because it accesses the server directly to retrieve the page source. Another advantage is it returns the status of the server. So, if there is problem it can be identified. The data between the start and end tag is copied down the worksheet from a cell you specify. One of the macros is used to convert HTML amp codes i.e.   into actual characters.

The macro ScrapeData is setup to read a list of URLs. Each URL's parsed tag pair data is added to a single column on "Sheet2" below the header row. The data from the next URL is placed in the next column to the right. Previous data is cleared before the new data is copied. Have a look a let me know if you need any changes made.

Hello Rui,

The code is written to extract the text between the tags. What you are looking for is a tag attribute. This macro will put all the language attributes of a web page into the collection called "Matches". This is zero based collection meaning the first element is at index zero of the collection.

' Written: October 20, 2011
' Author:  Leith Ross
' Summary: Finds all the langauge attributes on a web page

Sub ParseLanguage()

    Dim ieApp As Object
    Dim ieDoc As Object
    Dim Lang As String
    Dim Matches As Object
    Dim RegExp As Object
    Dim Text As String
    Dim URL As String
    
        URL = "http://www.cpu-world.com/"
        
        Set ieApp = CreateObject("InternetExplorer.Application")
        
            ieApp.Navigate URL
            ieApp.Visible = True
            
            While ieApp.Busy And ieApp.ReadyState <> 4: DoEvents: Wend
            
            While ieDoc Is Nothing: Set ieDoc = ieApp.Document: DoEvents: Wend
            
              ' Returns the source text
                Text = ieDoc.body.outerHTML
                
              ' Parse out the language attributes for either XML or HTML
                Set RegExp = CreateObject("VBScript.RegExp")
                RegExp.Global = True
                RegExp.Pattern = "([xml\:l|\sl]ang="".{2,9}(?:""))\s"
         
                  ' Display the number of matching attributes and assign first match to the variable Lang
                    If RegExp.Test(Text) Then
                     ' Return a collection of all matches
                       Set Matches = RegExp.Execute(Text)
                       MsgBox Matches.Count & " Language attribute(s) found."
                       Lang = Matches(0)    ' First Match
                    End If
            
End Sub

Hello Ru1,

I don't see why not. Can you provide me with the code you are using now?

Hello Ru1,

I can combine them but I need a little more information from you.

Where would the language information go on the page?
Would need all of the language attributes or just 1?

Hello Ru1,

I rewrote the macro to operate as function that takes the URL as its argument. It will then return the object. If the object is Nothing then no language attributes were found. There is a second macro which will the languages on the web page you posted.

' Written: October 20, 2011
' Author:  Leith Ross
' Summary: Returns all the langauge attributes on a web page

Function GetLanguages(ByVal URL As String) As Object

    Dim ieApp As Object
    Dim ieDoc As Object
    Dim Lang As String
    Dim Matches As Object
    Dim RegExp As Object
    Dim Request As Object
    Dim Text As String
    

        On Error Resume Next
           Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
           If Request Is Nothing Then
              Set Request = CreateObject("WinHttp.WinHttpRequest.5")
           End If
        Err.Clear
        On Error GoTo 0

        Request.Open "GET", URL, False
        Request.Send
    
        Text = Request.responsetext
                
              ' Parse out the language attributes for either XML or HTML
                Set RegExp = CreateObject("VBScript.RegExp")
                RegExp.Global = True
                RegExp.Pattern = "([xml\:l|\sl]ang="".{2,9}(?:""))\s"
         
                  ' Display the number of matching attributes and assign first match to the variable Lang
                    If RegExp.Test(Text) Then
                     ' Return a collection of all matches
                       Set Matches = RegExp.Execute(Text)
                    End If
                    
        Set GetLanguages = Matches
         
End Function

Sub LangTest()

    Dim Lang As Variant
    Dim Languages As Object
    Dim Msg As String
  
        Set Languages = GetLanguages("http://www.acesso.umic.pt/webax/examinator.php")
    
        If Not Languages Is Nothing Then
           For Each Lang In Languages
               Msg = Msg & Lang & vbCrLf
           Next Lang
       
           MsgBox "The Lanaguage Attributes for this Page are:" & vbCrLf & vbCrLf & Msg
        End If
    
End Sub

Hello Ru1,

The macro returns a collection object of the matches. There would need to be additional code to copy those matches to another group of cells. I can expand the macro function to take a cell as another argument. It would then enter the languages found starting with that cell and go down. This could be called from the worksheet like a formula. Would that be a better option?