VBA to copy particular webpage content

T

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
5,331
Office Version
  1. 365
Platform
  1. Windows
Does anyone have code to copy the contents of a text file from a webpage?

For instance, from this page I only want the data in the text box, which can be selected by clicking the Highlight All button.

I've seen code to copy an entire page, but this does not capture the text box contents in this case.

Any help would be appreciated.

Robert
 
Sort by date Sort by votes
Hi Leith,

Don't be sorry re pick up your wife's prescriptions - family always first I say :) I'd picked some of mine this afternoon as well.

I've made some progress (see below) I just now need to copy the data back into a tab and create a text file of the same (don't ask):

Code: 
' Thread:  http://www.mrexcel.com/forum/showthread.php?t=603712
' Poster:  Trebor76
' Written: January 07, 2012
' Author:  Leith Ross
Option Explicit
Sub CopyWebText()

    Dim I As Long
    Dim X As Variant
    Dim ieApp As Object
    Dim ieDoc As Object
    Dim ieBtn As Object
    Dim ieBtns As Object
    Dim Shell As Object
    Dim Text As String
    Dim URL As String, _
        my_url As String
    
    URL = "http://www.abs.gov.au/AUSSTATS/abs@.nsf/webpages/ABS%20Release%20Calendar%20Export?opendocument"
        
    Set ieApp = CreateObject("InternetExplorer.Application")
        
    ieApp.Navigate URL
    ieApp.Visible = True
            
    While ieApp.Busy Or ieApp.ReadyState <> 4: DoEvents: Wend
            
    Set Shell = CreateObject("Shell.Application")
            
    'Loop through each open window until the URL's match
    For X = 0 To Shell.Windows.Count 'http://social.msdn.microsoft.com/Forums/en-MY/isvvba/thread/596c22cb-2140-404c-87b1-b115ecf1da03
        On Error Resume Next
            my_url = Shell.Windows(X).******************
        On Error GoTo 0
        If URL = my_url Then
            'Once the URL's have matched, set the required objects and quit.
            Set ieDoc = Shell.Windows(X).document
            Set ieBtns = ieDoc.getElementsByTagName("input")
            Exit For
        End If
    Next X
                    
    For I = 0 To ieBtns.Length - 1 'The count is always one more than the index
        If ieBtns(I).Value = "Highlight All" Then
            Set ieBtn = ieBtns(I)
            Exit For
        End If
    Next I
            
    If ieBtn Is Nothing Then MsgBox """Highlight All"" button not found.": Exit Sub
                
    ieBtn.Click
    
    'ieApp.ExecWB 12, 0
    'ieApp.ExecWB 17, 2
            
    Set ieApp = Nothing
    Set ieDoc = Nothing
    Set ieBtn = Nothing
    Set ieBtns = Nothing
    Set Shell = Nothing
                
End Sub

I couldn't seem to do anything with the statement ieApp.ExecWB 12, 0 or ieApp.ExecWB 17, 0.

Many thanks,

Robert
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hello Robert,

Okay, here is the code I just tested and it worked on my machine. It checks the windows for the one we are interested in. My old habit of assuming only one would be open bit mo thóin (Scottish Gaelic to avoid censoring).

Copy all of this into a single module. This create a new text file and paste the web text into it.
Code: 
' Thread:  http://www.mrexcel.com/forum/showthread.php?t=603712
' Poster:  Trebor76
' Written: January 07, 2012
' Author:  Leith Ross

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function StrLen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef pDst As Any, ByRef pSrc As Long, ByVal ByteLen As Long)

Function GetTextFromClipboard() As String
    
    Const CF_TEXT = 1
    
    Dim cch As Long
    Dim hStrPtr As Long
    Dim Text As String
    
        OpenClipboard (0)
      
        hStrPtr = GetClipboardData(CF_TEXT)
    
        If hStrPtr <> 0 Then
           cch = StrLen(hStrPtr)
              If cch > 0 Then
                 Text = String(cch, 0)
                 CopyMemory ByVal Text, ByVal hStrPtr, cch
                 GetTextFromClipboard = Text
              End If
        End If
        
      CloseClipboard
      
End Function

Sub CopyWebText()

    Dim Filename As String
    Dim fn As Integer
    Dim I As Long
    Dim ieApp As Object
    Dim ieDoc As Object
    Dim ieBtn As Object
    Dim ieBtns As Object
    Dim oShell As Object
    Dim Text As String
    Dim URL As String
    
        Filename = "Copy of AusStats.txt"
        
        URL = "http://www.abs.gov.au/AUSSTATS/abs@.nsf/webpages/ABS%20Release%20Calendar%20Export?opendocument"
        
        Set ieApp = CreateObject("InternetExplorer.Application")
        
            ieApp.Navigate URL
            ieApp.Visible = True
            
            While ieApp.Busy Or ieApp.ReadyState <> 4: DoEvents: Wend
            
            
            Set oShell = CreateObject("Shell.Application")
            
            For Each oShWindow In oShell.Windows
                If oShWindow.LocationName = "ABS Release Calendar Export" Then
                   Set ieDoc = oShWindow.Document
                End If
            Next oShWindow
            
            
                Set ieBtns = ieDoc.getElementsByTagName("input")
                
                For I = 0 To ieBtns.Length - 1
                    If ieBtns(I).Value = "Highlight All" Then
                       Set ieBtn = ieBtns(I)
                       Exit For
                    End If
                Next I
                
                If ieBtn Is Nothing Then MsgBox """Highlight All"" button not found.": Exit Sub
                
                ieBtn.Click
                
                ieApp.ExecWB 12, 0
                
            Text = GetTextFromClipboard
            
            fn = FreeFile
            
            Open Filename For Output Access Write Lock Write As #fn
                Print #fn, Text
            Close fn
            
        ieApp.Quit
        
End Sub
 
Upvote 0
Hey Leith,

Just had to incorporate the path into the Filename variable and tweak the creation of the text file as so:

Code: 
Open Filename For Output As #fn
        Print #fn, Text
    Close #fn

But besides that - it worked!!!

One last question, how would I loop through the items in the windows clipboard into a sheet?

Kind regards,

Robert
 
Upvote 0
Hello Robert,

Not sure I understand what you want to do with the data. Do you want to copy each line of data as comma separated values on to the sheet?
 
Upvote 0
Hello Robert,

This version of the "CopyWebText" macro will copy the text to "Sheet2". You can change this to the sheet name you are using. Most of the data is enclosed in double quotes. No sure if the quotes can be eliminated when copying the data from the clipboard.
Code: 
Sub CopyWebText()

    Dim ColData As Variant
    Dim Filename As String
    Dim fn As Integer
    Dim I As Long
    Dim ieApp As Object
    Dim ieDoc As Object
    Dim ieBtn As Object
    Dim ieBtns As Object
    Dim oShell As Object
    Dim Rng As Range
    Dim RowData As Variant
    Dim Text As String
    Dim URL As String
    Dim Wks As Worksheet
    
        Set Wks = Worksheets("Sheet2")
        Set Rng = Wks.Range("A1")
        
        Filename = "Copy of AusStats.txt"
        
        URL = "http://www.abs.gov.au/AUSSTATS/abs@.nsf/webpages/ABS%20Release%20Calendar%20Export?opendocument"
        
        Set ieApp = CreateObject("InternetExplorer.Application")
        
            ieApp.Navigate URL
            ieApp.Visible = True
            
            While ieApp.Busy Or ieApp.ReadyState <> 4: DoEvents: Wend
            
            
            Set oShell = CreateObject("Shell.Application")
            
            For Each oShWindow In oShell.Windows
                X = TypeName(oShWindow)
                If oShWindow.LocationName = "ABS Release Calendar Export" Then
                   Set ieDoc = oShWindow.Document
                End If
            Next oShWindow
            
            
                Set ieBtns = ieDoc.getElementsByTagName("input")
                
                For I = 0 To ieBtns.Length - 1
                    If ieBtns(I).Value = "Highlight All" Then
                       Set ieBtn = ieBtns(I)
                       Exit For
                    End If
                Next I
                
                If ieBtn Is Nothing Then MsgBox """Highlight All"" button not found.": Exit Sub
                
                ieBtn.Click
                
                ieApp.ExecWB 12, 0
                
            Text = GetTextFromClipboard
            
            fn = FreeFile
            
            Open Filename For Output Access Write Lock Write As #fn
                Print #fn, Text
            Close fn
            
            
            RowData = Split(Text, vbCrLf)
            
            For I = 0 To UBound(RowData) - 1
                ColData = Split(RowData(I), ",")
                Rng.Offset(I, 0).Resize(1, UBound(ColData) - 1).Value = ColData
            Next I
            
        ieApp.Quit
        
End Sub
 
Upvote 0
Hey Ross,

Thanks you so much for you're continued efforts throughout the day on this. I really appreciate it.

Kind regards,

Robert
 
Upvote 0
Just out of curiosity, why are you using Shell?

If you are automating IE you can reference the document in the webpage with IE.document.

Or is more than one page opening when you navigate to the URL?
 
Upvote 0
Hello Norie,

In my experience, using Shell to access the Document object is far more reliable than using the Document property of the Application object. This has been true for either single or multiple tabs being open in the browser and with multiple instances of the browser being open. In the latter case, you can easily attach to another instance using Shell.
 
Upvote 0
Leith

I've honestly never seem it used apart from perhaps when working with already open pages.

Might look into it further, always interesting to see new methods, well new to me anyway.

How/when is it more reliable?

Is it with particular sites?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Extracting data with VBA macro button from files in designated folder
Replies
9
Views
207
CamBF
C
D
  • Question
Automatically add cell contents of specific range to cell comments when opening a document
Replies
3
Views
99
saboh12617
S
Anigito
  • Question
Get Webpage Title Text by URL Generated in MS Excel
Replies
1
Views
1K
Anigito
Anigito
A
  • Question
VBA for setting up the printing pages per sheet
Replies
0
Views
279
Aurum1
A
T
  • Solved
Inserting a table into HtmlBody of email in vba
Replies
3
Views
598
Domenic
D

Forum statistics

Threads
1,221,793
Messages
6,162,004
Members
451,737
Latest member
MRASHLEY

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top