Screen scrape doesn't run properly when played

R

rawdata

New Member
Joined
Oct 12, 2009
Messages
31
I am running a screen scrape in vba. When I step through the screen scrape it works fine. When I play the screen scrape, the code intermittenly scrapes the wrong set of screens. I'm stumped. I've got "While ie.Busy: DoEvents: Wend" all over the place.

Am I missing something?

Below is a sample of the code. The Sub WebPage() basically "calls" Sub GetOneTable():

Sub WePage()

LinkHref = "javascript:__doPostBack('GridView1','Select$13')": ie.navigate LinkHref
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$0')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$1')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.thewebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$2')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$3')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$4')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend
LinkHref = "javascript:__doPostBack('GridView1','Select$5')"
If LinkHref <> "" Then
ie.navigate LinkHref
End If
While ie.Busy: DoEvents: Wend
If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
While ie.Busy: DoEvents: Wend
GoTo Card27:
Else
End If
Set Doc = ie.Document
GetOneTable Doc, 1
Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxx", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ie.navigate "https://www.thewebpage.aspx"
While ie.Busy: DoEvents: Wend

End Sub

Sub GetOneTable(d, n)
' d is the document
' n is the table to extract
Dim e As Object ' the elements of the document
Dim t As Object ' the table required
Dim r As Object ' the rows of the table
Dim c As Object ' the cells of the rows
Dim I As Long
Dim J As Long
Range("A1").Select
Do Until ActiveCell.Row = 1048576
Selection.End(xlDown).Select
Loop
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
For Each e In d.all
If e.ID = "GridView1" Then
J = J + 1
End If
If J = n Then
Set t = e

tabno = tabno + 1
nextrow = nextrow + 1
Set Rng = ActiveCell
For Each r In t.Rows
For Each c In r.Cells
Rng.Value = c.innertext
Set Rng = Rng.Offset(, 1)
I = I + 1
Next c
nextrow = nextrow + 1
Set Rng = Rng.Offset(1, -I)
I = 0
Next r
Exit For
End If

Next e

End Sub
 
Sort by date Sort by votes
rawdata

Are those the actual URLs you are dealing with?

I don't think they are and it's kind of hard to help with this sort of thing without 'real' URLs.

That's also pretty hard code to follow with no indentation or an explanation of what it's meant to do.

There are also a few other things that don't look quite right - for example there is no label called Card27 and I wouldn't recommend using GoTo anywhere.

I hope you don't mind but I 'tidied up' the code.
Rich (BB code): 
Sub WePage()
 
    LinkHref = "javascript:__doPostBack('GridView1','Select$13')"
    
    ie.navigate LinkHref
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$0')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$1')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.thewebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$2')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$3')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$4')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
    
    LinkHref = "javascript:__doPostBack('GridView1','Select$5')"
    
    If LinkHref <> "" Then
        ie.navigate LinkHref
    End If
    
    While ie.Busy: DoEvents: Wend
    
    If ie.Document.URL = "https://www.theerrorwebpage.aspx" Then
        While ie.Busy: DoEvents: Wend
        GoTo Card27:
    End If
    
    Set Doc = ie.Document
    
    GetOneTable Doc, 1
    
    Cells.Replace What:="Select", Replacement:="xxxxxxxxxxxxxxx", LookAt:=xlPart, _
                  SearchOrder:=xlByRows, MatchCase:=False
                  
    ie.navigate "https://www.thewebpage.aspx"
    
    While ie.Busy: DoEvents: Wend
End Sub
 
Sub GetOneTable(d, n)
' d is the document
' n is the table to extract
Dim e As Object    ' the elements of the document
Dim t As Object    ' the table required
Dim r As Object    ' the rows of the table
Dim c As Object    ' the cells of the rows
Dim I As Long
Dim J As Long
 
    Range("A1").Select
    
    Do Until ActiveCell.Row = 1048576
        Selection.End(xlDown).Select
    Loop
    
    Selection.End(xlUp).Select
    
    ActiveCell.Offset(1, 0).Select
    
    For Each e In d.all
        If e.ID = "GridView1" Then
            J = J + 1
        End If
        If J = n Then
            Set t = e
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set Rng = ActiveCell
            For Each r In t.Rows
                For Each c In r.Cells
                    Rng.Value = c.innertext
                    Set Rng = Rng.Offset(, 1)
                    I = I + 1
                Next c
                nextrow = nextrow + 1
                Set Rng = Rng.Offset(1, -I)
                I = 0
            Next r
            Exit For
        End If
    Next e
 
End Sub
PS I don't recall using ActiveCell/Select/Selection when I wrote the code for GetOneTable.:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

9518423044
  • Question Question
I want to minimize this code. It takes a lot of time to do it. Is it? It is amazon data scraping code
Replies
5
Views
363
Joe4
Joe4
R
  • Question Question
Formatting using VBA
Replies
0
Views
569
RandyD123
R
B
  • Question Question
Screen scraping - all text ending up in one cell
Replies
1
Views
907
bifter
B
R
  • Question Question
Get values from HTML Input tag
Replies
0
Views
687
Razag
R
P
  • Question Question
WEB SCRAPING
Replies
2
Views
858
Paulo Silveira Xpto
P

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