Get Table from website into Excel VBA

Hi,

I work for a Stationery company and we constantly need to find cartridges for Printers with a Printer Supplied

I'm trying to get data from a website into Excel.
The Website is http://www.dynamicsupplies.com.au
the search URL is http://www.dynamicsupplies.com.au/search.php?Vendor2=Search+All+Manufacturers&q=%CODE%&Submit=Search
replacing %CODE% with a search string from Excel

I know a fair bit about Excel and VBA but i'm hopeless when it comes to HTML and the Code tags.

I've attached a before and after of what i would like
I have Chrome and (obviously) internet Explorer installed.

can anyone point me in the right direction?
EE---Dynamics-Search.xls
LVL 10
bromy2004Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

proadminCommented:
Believe it or not Excel is really good taking tables from HTML pages - try copy and pasting into your XLS file - if that isn't good then try copy and pasting into a Wordpad file and then into Excel from there.

Hope that helps!
0
bromy2004Author Commented:
I would normally do that,
thats how i got the "Results"
however the list is generally 10-50 Printers, and searching for each link and returning the table is time consuming
so i was hoping a macro would do it.
0
DaveCommented:
I'm working on it  ... it's a litte tricky as it requires regex parsing on an automated explorer html string

Cheers

Dave


0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

bromy2004Author Commented:
thank you dave,
although that last bit flew straight over my head. :s
0
DaveCommented:
This gets you 98% of the way there. :)

There is a little bit of data cleaning needed on column H

Cheers

DAve

Sub GetWeb()
    Dim objIe
    Dim objRegEx
    Dim RegMC
    Dim RegM
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim c As Range
    Dim strTemp As String

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With
    
    Set ws1 = ActiveWorkbook.Sheets(1)
    Set ws2 = ActiveWorkbook.Sheets(2)
    Set rng1 = ws1.Range(ws1.[b1], ws1.Cells(Rows.Count, "B").End(xlUp))
    Set objIe = CreateObject("internetexplorer.application")
    Set objRegEx = CreateObject("vbscript.regexp")

    objRegEx.Global = True

   ws2.UsedRange.ClearContents
    For Each c In rng1
        objIe.Navigate c.Value
        Do While objIe.ReadyState <> 4
            DoEvents
        Loop
        objRegEx.Pattern = "[\n\r\t]"
        '  Debug.Print objIe.Document.body.innerhtml
        strTemp = objIe.Document.body.innerhtml
        strTemp = objRegEx.Replace(strTemp, vbNullString)
        objRegEx.Pattern = "(<TD>.+?<\/TD>)+"
        Set RegMC = objRegEx.Execute(strTemp)
        For Each RegM In RegMC
            ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Replace(RegM, "</TD><TD>", "|")
        Next
    Next c
    ws2.Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, OtherChar:="|"
    ws2.Columns("A").Replace "<TD>", vbNullString
    ws2.Columns("I:M").ClearContents
    objIe.Quit
     With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    End With
End Sub

Open in new window

EE---Dynamics-Search-1.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bromy2004Author Commented:
I've run in on my Workbook as well as your supplied workbook, but the TextToColumns isn't working

How does the RegExp work?
I noticed you've set the "Pattern" twice.
ScreenShot002.jpg
0
DaveCommented:
Thats strange, it should just be splitting the column on the "|" data as my sample file did. I presume it works manually?

I retested my file and it worked fine

I use the first pattern to strip out all line breaks so that I have a single string to parse, the second pattern looks for strings contained in between the </TD> and </TD>

Cheers

Dave
0
bromy2004Author Commented:
Figured it out,

the TextToColumns was missing  Other:=True
Have added and works fine, except for the last line, which remains as a long string
0
DaveCommented:
Yep, that was the 2% part I figured would be your direction bit.

 I'm out of time to tweak that part further :)

Dave
0
tilsantCommented:
After looking at u guys, im seriously thinking of learning VB!!

But for now, this is from my side (i guess this is going to be the crudest code ever!!)
:P


Tils.
0
tilsantCommented:
the code follows ;)
Sub Macro4()
    Sheets("Search for").Select
    Range("A1:A2").Select
    rng = Selection
    Sheets.Add
    Dim x As Variant
    For Each x In rng
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.dynamicsupplies.com.au/search.php?Vendor2=Search+All+Manufacturers&q=" & x & "&Submit=Search" _
        , Destination:=ActiveCell)
        .Name = _
        "search.php?Vendor2=Search+All+Manufacturers&q=" & x & "&Submit=Search"
        .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 = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Selection.End(xlToLeft).Select
    Selection.EntireRow.Delete
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Insert Shift:=xlToRight
    ActiveCell.Select
    Selection.End(xlToLeft).Select
    ActiveCell.Value = x
    ActiveCell.Copy
    Selection.End(xlToRight).Select
    Selection.End(xlDown).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.EntireRow.Delete
    Next
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.EntireRow.Insert
    ActiveCell.FormulaR1C1 = "Original Code"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Dynamic Code"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Vendor Code"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Manufacturer"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Description"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Colour"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Yield"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Category"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Printer Models"
    ActiveCell.Offset(0, 1).Range("A1:C1").Select
    Selection.EntireColumn.Delete
    ActiveCell.Cells.Select
    ActiveCell.Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub

Open in new window

0
bromy2004Author Commented:
Tils,
That is really good, and clear enough to understand.

I'll use that one with another macro i'm using.
0
bromy2004Author Commented:
Well done and Thank you to Dave and Tils
0
tilsantCommented:
k....... kool :)
0
tilsantCommented:
Thanks for the Points, Broomy =)


Tils.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Web Browsers

From novice to tech pro — start learning today.