Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Problem with querytables

Status
Not open for further replies.

osx99

Technical User
Apr 9, 2003
250
GB
The code below cycles through a list of approx 2800 numbers in excel, copies the accociated web page to another worksheet then performs calcs before copying results back onto intial worksheet

All worked fine until a few weeks ago, now the code only copies the webpages intermittently. It sometimes works ok for the first 50 or so then stops. Never the same number on the list either

it's something to do with this section I think

Code:
With ActiveSheet.QueryTables.Add(Connection:="URL;[URL unfurl="true"]http://www.discogs.com/sell/list?release_id="[/URL] & release_id.Value, _
                Destination:=Range("a3")) 'write web-page to sheet

I can't work it out what is wrong - anyone any clues?

Code and working attachment are enclosed

Code:
Sub Discog_Extract()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

    Dim USD As Currency
    Dim EUR As Currency
    Dim GBP As Currency
    
    Dim MaxPrice As Currency
    Dim MinPrice As Currency
    Dim AvgPrice As Currency
    Dim countrecords As Long
    
    Dim release_id As Range
    Dim theRange As Range
      
               
    EUR = 0.695532      ' Set exchange rates for your country - your own currency should equal 1
    USD = 0.480307       ' Set exchange rates for your country - your own currency should equal 1
    GBP = 1             ' Set exchange rates for your country - your own currency should equal 1
    
    Worksheets("items").Activate
    With ActiveSheet
    For Each release_id In Intersect(.UsedRange, .Range("e1:e2802"))
        On Error Resume Next
        If release_id.Value = "" Then Exit Sub
        If release_id.Value = "release_id" Then
                Worksheets("items").Activate
                    release_id.Offset(0, 8) = "MaxPrice"
                    release_id.Offset(0, 9) = "MinPrice"
                    release_id.Offset(0, 10) = "AvgPrice"
                    release_id.Offset(0, 11) = "Number on Sale"
                    release_id.Offset(0, 12) = "Data Extracted on"
                    
        Else
                 


                Worksheets("Web download").Activate
                Range("A:z").Select
                Selection.ClearContents
                Selection.ClearFormats

                With ActiveSheet.QueryTables.Add(Connection:="URL;[URL unfurl="true"]http://www.discogs.com/sell/list?release_id="[/URL] & release_id.Value, _
                Destination:=Range("a3")) 'write web-page to sheet

                     .BackgroundQuery = True
                     .TablesOnlyFromHTML = False
                     .Refresh BackgroundQuery:=False
                     .SaveData = True


                End With
                
                Set theRange = Range("d:d")

                Dim c As Range
                For Each c In theRange
                 If (c.Offset(3, -2)) = "Media Condition: Near Mint (NM or M-)" Then
                'MsgBox (c.Offset(3, -2))
                If Val(c) > 0 Then c.Offset(0, 1) = Val(c) * EUR
                 c.Offset(0, 2) = Left(c.NumberFormat, 1) ' test number format remove from final version
    
                        Select Case Left(c, 1)
                            Case "€": c.Offset(0, 1) = Val(Mid(c, 3)) * EUR
                            Case "$": c.Offset(0, 1) = Val(Mid(c, 3)) * USD
                            Case "£": c.Offset(0, 1) = Val(Mid(c, 3)) * GBP
                            End Select
                            
                            Select Case Left(c.NumberFormat, 1)
                            Case "$": c.Offset(0, 1) = Val(c) * GBP
                            End Select
                            
                  End If
                  If (c.Offset(3, -2)) = "Media Condition: Mint (M)" Then
                'MsgBox (c.Offset(3, -2))
                If Val(c) > 0 Then c.Offset(0, 1) = Val(c) * EUR
                 c.Offset(0, 2) = Left(c.NumberFormat, 1) ' test number format remove from final version
    
                        Select Case Left(c, 1)
                            Case "€": c.Offset(0, 1) = Val(Mid(c, 3)) * EUR
                            Case "$": c.Offset(0, 1) = Val(Mid(c, 3)) * USD
                            Case "£": c.Offset(0, 1) = Val(Mid(c, 3)) * GBP
                            End Select
                            
                            Select Case Left(c.NumberFormat, 1)
                            Case "$": c.Offset(0, 1) = Val(c) * GBP
                            End Select
                  End If
                            
                            Next

                    Set theRange = Range("E:E")
 
                    MaxPrice = Application.Max(theRange)
                    MinPrice = Application.Min(theRange)
                    AvgPrice = Application.Average(theRange)
                    countrecords = Application.count(theRange)


                    Worksheets("items").Activate
                    If countrecords > 0 Then
                        release_id.Offset(0, 8) = MaxPrice
                        release_id.Offset(0, 9) = MinPrice
                        release_id.Offset(0, 10) = AvgPrice
                        release_id.Offset(0, 11) = countrecords
                        release_id.Offset(0, 12) = Now()
                    End If

                    'MsgBox MaxPrice & " " & MinPrice & " " & AvgPrice & " " & countrecords

        End If
        
            
        Next release_id
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
  End Sub
 

I've been looking at this more and the retrieval of web page data seems to be causing either a run-time error 1004 the file could not be accessed

or

produces an error since there is a ? in the URL

Seems strange as it works for some data retrievals but fails on others

Any known solution for this?
 





Is it ALWAYS the same value?

Can you access the URL with that same value MANUALLY?

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
No not the same value and can always access the URL manually

Wondering if it's something to do with accessing the URL timing out.

The full excel file and macro are attached if that helps?
 

It's definitely this part of the code producing a run-time error 1004

.Refresh BackgroundQuery:=False
 




You get that kind of error when the query connection or commandtext (which a web query does not need) has a problem.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
Does that mean I should remove or alter true/false?

.BackgroundQuery = True
.Refresh BackgroundQuery:=False

Both still give 1004 error
 
That code sets the background query to true and then in the next line sets it to false again. you have changed nothing:

.BackgroundQuery = True
.Refresh

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
I've tried this code on another machine and all seems to work correctly. However, both my machines at home present probles

Could the version of excel or operating system have bearing on this?

Very strange..
 
which line of code does it fail on?

When it fails, choose debug and post the line highlighted in yellow

Other than that, my bets would be on a connection timeout for the query due to web page load times...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 

fails on this line intermittently with error 1004 at home but no problems on work machine

Refresh BackgroundQuery:=False

would temporary internet files have anything to do with this?

 

I re-installed XP and excel and this code now runs like a dream.... bizarre!

I think the querytables command must cache some temporary files which reach a maximum allowed number. Pure speculation, no idea exactly but would be interested to know if anyone had any clues to this?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top