Excel Web Query for Data Import

P

poldim

New Member
Joined
Dec 16, 2008
Messages
31
Here is the situation:
I have a list of part numbers that I want excel to look up data from the web page and provide cost information. The specific page for each part number is static with the exception of the part number itself. The built in "From Web" feature currently pulls in 9 lines of information. This would be great if I can have it only display row 4



The part number webpage:
http://www.schneider-electric.us/pr...Detail&partNumber=ATV71LD11N4Z&countryCode=us

Data from "From Web" inquiry:
<table style="border-collapse: collapse; width: 368pt;" border="0" cellpadding="0" cellspacing="0" width="491"><tbody><tr style="height: 15pt;" height="20"><td style="height: 15pt; width: 368pt;" height="20" width="491">ATV71LD11N4Z</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">Altivar 71 Lift Drive, 460Vac, 15 HP</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">
</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">$2,733.60 List Price</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">Non-Stock Item: This item is not normally stocked in our distribution facility.</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">
</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">Qty.</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">
</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20"> Product Datasheet
</td> </tr> </tbody> </table>
Click to expand...
For example:
Input part numbers by copying and pasting
<table style="border-collapse: collapse; width: 83pt;" border="0" cellpadding="0" cellspacing="0" width="110"><col style="width: 83pt;" width="110"> <tbody><tr style="height: 15pt;" height="20"> <td class="xl64" style="height: 15pt; width: 83pt;" height="20" width="110">ATV71LD11N4Z</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl64" style="height: 15pt;" height="20">ATV71LD15N4Z</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl64" style="height: 15pt;" height="20">ATV71LD18N4Z</td> </tr> </tbody></table>
Click to expand...
would be referenced from
<table style="border-collapse: collapse; width: 502px; height: 108px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" width="64"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 48pt;" height="20" width="64">http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&partNumber=ATV71LD11N4Z&countryCode=us</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&partNumber=ATV71LD15N4Z&countryCode=us</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&partNumber=ATV71LD18N4Z&countryCode=us
</td> </tr> </tbody></table>
Click to expand...
-----------------
Ideally, I would like to set it up either in a formula or a macro that would provide me with table: part number; part description; part cost
This is essentially a table with: the input data; row 2 from the web query; and row 4
<table style="border-collapse: collapse; width: 426px; height: 96px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 83pt;" width="110"> <col style="width: 170pt;" width="350"> <col style="width: 52pt;" width="69"> <tbody><tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; width: 83pt;" height="20" width="110">ATV71LD11N4Z</td> <td class="xl66" style="width: 250pt;" width="350">Altivar 71 Lift Drive, 460Vac, 15 HP</td> <td class="xl67" style="width: 52pt;" align="right" width="69">$2,733.60 </td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt;" height="20">ATV71LD15N4Z</td> <td class="xl66">Altivar 71 Lift Drive, 460Vac, 20 HP</td> <td class="xl67" align="right">$3,398.40 </td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt;" height="20">ATV71LD18N4Z</td> <td class="xl66">Altivar 71 Lift Drive, 460Vac, 25 HP</td> <td class="xl67" align="right">$4,089.60 </td> </tr> </tbody></table>
Click to expand...
 
Sort by date Sort by votes
Try this. It creates or uses the existing query on Sheet3 and populates the data on Sheet1 using part numbers in column A row 2 onwards.
Code: 
Option Explicit

Sub Macro1()
    
    Dim URL As String
    Dim qt As QueryTable
    Dim lastRow As Long
    Dim partNumber As Range
    
    URL = "http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&countryCode=us"
    
    With Sheet3
        If .QueryTables.Count = 0 Then
            Set qt = .QueryTables.Add(Connection:="URL;", Destination:=.Range("A1"))
            With qt
                .Name = "query"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "1"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
            End With
        Else
            Set qt = .QueryTables(1)
        End If
    End With
    
    With Sheet1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each partNumber In .Range("A2:A" & lastRow)
            qt.Connection = "URL;" & URL & "&partNumber=" & partNumber.Value
            qt.Refresh BackgroundQuery:=False
            partNumber.Offset(, 1).Value = Sheet3.Range("B2")
            partNumber.Offset(, 2).Value = Split(Sheet3.Range("B4"), " ")(0)
            DoEvents
        Next
    End With

End Sub
 
Upvote 0
John, Thanks for your help. I loaded this in and it works perfectly. I noticed it ignores the first row (I am guessing this was for a header). I have updated to reflect my sheets (4 & 5) and will look into if I can get it to check all rows as sheet 4 will not have a header.
 
Upvote 0
John,

Here is a copy of the macro. I modified the name and sheet references so that it works in my workbook. I have tried running your exact code in another file and receive the same error.

Code: 
Option Explicit

Sub web_lookup()
    
    Dim URL As String
    Dim qt As QueryTable
    Dim lastRow As Long
    Dim partNumber As Range
    
    URL = "http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&countryCode=us"
    
    With Sheet5
        If .QueryTables.Count = 0 Then
            Set qt = .QueryTables.Add(Connection:="URL;", Destination:=.Range("A1"))
            With qt
                .Name = "query"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "1"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
            End With
        Else
            Set qt = .QueryTables(1)
        End If
    End With
    
    With Sheet4
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each partNumber In .Range("A1:A" & lastRow)
            qt.Connection = "URL;" & URL & "&partNumber=" & partNumber.Value
            qt.Refresh BackgroundQuery:=False
            partNumber.Offset(, 1).Value = Sheet5.Range("B2")
            partNumber.Offset(, 2).Value = Split(Sheet5.Range("B4"), " ")(0)
            DoEvents
        Next
    End With

End Sub
 
Upvote 0
Your code works successfully for me (in a new workbook with 2 new worksheets which are automatically assigned code names Sheet4 and Sheet5). What error do you get? You haven't said.

Do you have sheets with code names Sheet4 and Sheet5? These names are not necessarily the same as the sheet name tabs.
 
Upvote 0
John_w said:
Your code works successfully for me (in a new workbook with 2 new worksheets which are automatically assigned code names Sheet4 and Sheet5). What error do you get? You haven't said.

Do you have sheets with code names Sheet4 and Sheet5? These names are not necessarily the same as the sheet name tabs.
Click to expand...

vshp8o.jpg


Yes, for the first time I ran the code it worked. There were ~15 line items that it successfully ran. I googled the code and people suggest everything from rebooting, to registry cleaners. I run a weekly registry cleaner so I dont think that is the issue and reboot daily. Is it possible the site is blocking it for excessive requests?
 
Upvote 0
Yes, the site could be blocking due to the number or frequency of requests. You could try pausing between query using Application.Wait, or use Application.OnTime to request batches of part numbers.

Another cause of error 1004 with web queries is the IE cache overflowing. You could try increasing the size of the IE cache (temporary internet files), or the VBA solution in http://www.mrexcel.com/forum/showthread.php?t=295618&page=2 which deletes the cache every few web queries. The modified code using this technique (deleting every 10 part numbers) is:
Code: 
Sub Macro1()
    
    Dim URL As String
    Dim qt As QueryTable
    Dim lastRow As Long
    Dim partNumber As Range
    
    URL = "http://www.schneider-electric.us/products-services/product-detail/?event=productDetail&countryCode=us"
    
    With Sheet3
    If .QueryTables.Count = 0 Then
            Set qt = .QueryTables.Add(Connection:="URL;", Destination:=.Range("A1"))
            With qt
                .Name = "query"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "1"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
            End With
        Else
            Set qt = .QueryTables(1)
        End If
    End With
    
    With Sheet1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each partNumber In .Range("A2:A" & lastRow)
            qt.Connection = "URL;" & URL & "&partNumber=" & partNumber.Value
            qt.Refresh BackgroundQuery:=False
            partNumber.Offset(, 1).Value = qt.Parent.Range("B2")
            partNumber.Offset(, 2).Value = Split(qt.Parent.Range("B4"), " ")(0)
            DoEvents
            If partNumber.Row Mod 10 = 0 Then Clear_IE_Cache
        Next
    End With

End Sub

Sub Clear_IE_Cache()
    ' whack temp files - Process 8
    Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8"
    ' whack history files - Process 1
    Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 1"
End Sub
 
Upvote 0
Thanks again John, it looks like that may have solved it. I changed the frequency from 10 to 50 and it seems to be working fine.
 
Upvote 0
Code: 
Sub Clear_IE_Cache()
    ' whack temp files - Process 8
    Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8"
    ' whack history files - Process 1
    Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 1"
End Sub
Click to expand...
John,

I copied the xlsb workbook from my Win 7 Ultimate machine to my Win Server 2008 R2 box and it seems like the shell commands aren't working. In the debug mode, if I step into the sub routine and run it, its goes through all steps but nothing appears on the screen like on my Win 7 machine. However, the server does get pretty far before seeing the same 1004 error, anywhere from 4000-9000 line items completed. It doesn't throw any errors when it executes the sub routine.

I have it set to run through my entire catalog of ~250,000 items, so it would help if it just ran through since I only check it once a day or so. Thanks in advance!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
914
smozgur
smozgur
R
  • Question Question
Find the value in a string using the corresponding phrase
Replies
1
Views
91
reznx
R
E
  • Question Question
VBA code clean up
Replies
9
Views
698
mumps
mumps
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
3K
Attrazion
A
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
1K
epactheactor
E

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