Retrieve information from website using VBA

If anyone could help me, it would be much appreciated. But I am looking to build a macro that will look up an item number that I type in excel, and do a search on a website like Amazon, or any other retailer, and return information from that search such an item price, specs, etc.

I am not even 100% sure that this is possible, but I figured to ask if anyone had an idea.

Thanks Leith,

Here is one of the examples of a site that I would use...

www.lowes.com

I would search an item number of an item, example " RTW4640YQ"

In this case, an appliance pops up. I would want to bring in the price ($399 in this case)

How would I write this?

Is this what you are wanting to do?

Sub Mehl()

On Error GoTo exits
    
Dim LOIE  As SHDocVw.InternetExplorer 'microsoft internet controls (shdocvw.dll)
Dim htmlDoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection
Dim partNum As String

            
    partNum = Application.InputBox("What are we searching for at Lowes today?", "Lowes Home Improvement", Type:=2)

    Set LOIE = New SHDocVw.InternetExplorer
    With LOIE
        .navigate "http://www.lowes.com/SearchCatalogDisplay?storeId=10151&langId=-1&catalogId=10051&N=0&newSearch=true&Ntt=" & partNum & ""
        .Visible = 1
        Do While .readyState <> 4: DoEvents: Loop
            Application.Wait (Now + TimeValue("0:00:02"))

            Set htmlDoc = .document
            Set htmlColl = htmlDoc.getElementsByTagName("INPUT")
            Do While htmlDoc.readyState <> "complete": DoEvents: Loop
                For Each htmlInput In htmlColl
                    If htmlInput.ID = "Ntt" Then
                        htmlInput.Value = partNum
                    End If
                Next htmlInput
       End With
                
 

        LOIE.ExecWB 17, 0
        LOIE.ExecWB 12, 2
       
        With ActiveSheet.Range("A1").Select
            ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
             False
        End With
        For Each S In ActiveSheet.Shapes
            S.Cut
        Next
        Application.CutCopyMode = False
        Set LOIE = Nothing
            
        Rows("1:150").Delete Shift:=xlUp
            
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationManual
            Application.EnableEvents = True
        MsgBox "Done!", vbOKOnly
  Exit Sub
exits:
    
    LOIE.Quit
    Set LOIE = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = True
    Application.CutCopyMode = False
    MsgBox Err.Description
    Exit Sub


End Sub

Or try this one, much faster..

Option Explicit
Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
 Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte

 Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 oXMLHTTP.Open "GET", vWebFile, False
 oXMLHTTP.send
 Do While oXMLHTTP.readyState <> 4
  DoEvents
 Loop
 
 oResp = oXMLHTTP.responseBody
 vFF = FreeFile
 If Dir(vLocalFile) <> "" Then Kill vLocalFile
 Open vLocalFile For Binary As #vFF
 Put #vFF, , oResp
 Close #vFF
 

 Set oXMLHTTP = Nothing
End Function

Sub Lowes()

    Dim partNum As String
    Dim S As Shapes
    Dim path As String
    
      On Error GoTo Exits
 
        partNum = Application.InputBox("What are we searching for at Lowes today?", "Lowes Home Improvement", Type:=2)

        SaveWebFile "http://www.lowes.com/SearchCatalogDisplay?storeId=10151&langId=-1&catalogId=10051&N=0&newSearch=true&Ntt=" & partNum & "", "C:\Users\Keith\Desktop\NewFiles\" & partNum & "-Lowes.xls"
        
        path = "C:\Users\Keith\Desktop\NewFiles\" & partNum & "-Lowes.xls"
        
        Workbooks.Open path
     

Exit Sub

Exits:
    Exit Sub
    
    
End Sub

Thanks for the response.

I think this is kind of on the right path, but what I am looking to do is have a column of about 10-15 item numbers, and when I run the macro, it will go retrieve the prices of those items from Lowes website.

Like this?

Option Explicit
Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
 Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte

 Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 oXMLHTTP.Open "GET", vWebFile, False
 oXMLHTTP.send
 Do While oXMLHTTP.readyState <> 4
  DoEvents
 Loop
 
 oResp = oXMLHTTP.responseBody
 vFF = FreeFile
 If Dir(vLocalFile) <> "" Then Kill vLocalFile
 Open vLocalFile For Binary As #vFF
 Put #vFF, , oResp
 Close #vFF
 

 Set oXMLHTTP = Nothing
End Function

Sub Lowes()

 Dim partNum As String
 Dim path As String
    
   On Error GoTo Exits
 
    partNum = Application.InputBox("What are we searching for at Lowes today?", "Lowes Home Improvement", Type:=2)
    path = "C:\Users\blah\Desktop\Lowes\" & partNum & "-Lowes.xls"        '<======== Make sure to provide a path here to save in
    
    SaveWebFile "http://www.lowes.com/SearchCatalogDisplay?storeId=10151&langId=-1&catalogId=10051&N=0&newSearch=true&Ntt=" & partNum & "", "C:\Users\blah\Desktop\Lowes\" & partNum & "-Lowes.xls" '<======== Or do it here

     Workbooks.Open path
      Format_Results

        With Range("A1:B1").Select
            Selection.Insert Shift:=xlDown
            Selection.Interior.ColorIndex = 35
        End With
        Range("A1").Value = "Results for :"
        Range("B1").Value = partNum
        Range("C1").Value = "=COUNTA(B:B)-1"
        Range("D1").Value = "Results Found"
    Exit Sub
Exits:
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
     MsgBox Err.Description
    Exit Sub
End Sub

Public Function Format_Results()
 
 Dim name1 As String
 Dim xcell As Range
 Dim S As Object

    name1 = "Model #"

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

            With Cells.Select
                Selection.UnMerge
            End With
             
             Range("B:B").ClearContents
                Range("A1:A1000").Select
                    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                        Other:=True, OtherChar _
                        :=":", FieldInfo:=Array(1, 1)
                
                With Range("A1:A1000").Select
                   For Each xcell In Selection
                        If xcell <> name1 Then xcell.ClearContents
                    Next
                Selection.ColumnWidth = 12
                
                For Each S In ActiveSheet.Shapes
                                 S.Cut
                            Next
                End With
                Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete Shift:=xlUp

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Function

Oh wow! Sorry... I just realized, the site redirects unless you select your zipcode. That is why the price didnt show up and lord knows why or how i missed that. . . Let me try that again

Is there a way to have the prices appear in the same file as the item numbers? So if i have a list of items in column C, then the prices would appear in column D?

Im not sure how i would get around that redirect using that method. . This might work though, needs some cleaning but it should get the job done:

Dim part As String

    part = "washer" 'Application.InputBox("County:", "The Anti-Pat Brigade", Type:=2)
    Set LOIE = New SHDocVw.InternetExplorer
    
    With LOIE
        .navigate ("http://www.lowes.com/Search=" & part & "?storeId=10151&langId=-1&catalogId=10051&N=0&newSearch=true&Ntt=" & part & "") ' Main page
        .Visible = 0
        Do While .readyState <> 4: DoEvents: Loop
            LOIE.ExecWB 17, 0
            LOIE.ExecWB 12, 0
            LOIE.Quit
         With Range("B1").Select
            ActiveSheet.PasteSpecial Format:="TEXT", link:=False, DisplayAsIcon:=False
            Application.CutCopyMode = False
        End With
        Range("B:B").SpecialCells(xlBlanks).Delete shift:=xlUp
        Range("B:B").SpecialCells(xlBlanks).Delete shift:=xlUp
    End With
    
    Extract_Model_Price
 
 Columns(2).ClearContents
 Columns(1).SpecialCells(xlBlanks).Delete shift:=xlUp
 Columns(1).ColumnWidth = 40
 Columns(1).SpecialCells(xlBlanks).Delete shift:=xlUp
 
End Sub


Public Function Extract_Model_Price()


Dim MyCol   As Range
Dim vFIND   As Range
Dim vFIRST  As Range
  
  On Error Resume Next
    
    MyVal = "#"
      Set MyCol = Columns(2) 'Application.InputBox("Now highlight a column for me to search.", Type:=8)
      Set vFIND = MyCol.Find(MyVal, MyCol.Cells(1), xlValues, xlPart, xlByRows, xlNext, False)
            If Not vFIND Is Nothing Then
                Set vFIRST = vFIND
                Do
                    vFIND.Offset(0, -1).Delete shift:=xlToLeft
                    Set vFIND = MyCol.FindNext
                Loop Until vFIND.Address = vFIRST.Address
              Else
        End If
    MyVal2 = "MSRP"
      Set MyCol = Columns(2) 'Application.InputBox("Now highlight a column for me to search.", Type:=8)
      Set vFIND = MyCol.Find(MyVal2, MyCol.Cells(1), xlValues, xlPart, xlByRows, xlNext, False)
            If Not vFIND Is Nothing Then
                Set vFIRST = vFIND
                Do
                    vFIND.Offset(0, -1).Delete shift:=xlToLeft
                    Set vFIND = MyCol.FindNext
                Loop Until vFIND.Address = vFIRST.Address
              Else
        End If
     MyVal3 = "$"
      Set MyCol = Columns(2) 'Application.InputBox("Now highlight a column for me to search.", Type:=8)
      Set vFIND = MyCol.Find(MyVal3, MyCol.Cells(1), xlValues, xlPart, xlByRows, xlNext, False)
            If Not vFIND Is Nothing Then
                Set vFIRST = vFIND
                Do
                    vFIND.Offset(0, -1).Delete shift:=xlToLeft
                    Set vFIND = MyCol.FindNext
                Loop Until vFIND.Address = vFIRST.Address
              Else
        End If

    Set MyCol = Nothing
    Set vFIRST = Nothing
    Set vFIND = Nothing
 
End Function

Thanks alot for your help.

I am getting an error at the beginning of it though, at the "dim LOIE" part. It is saying "User defined type not defined".

Nevermind...I didnt have internet controls enabled. Fixed it.

When I run it however, it is just pasting in all the text from page of the search result. Also, right now, it is set to only search that same item. If i had a list of 5 items, how would i edit the search?

Ideally, what I would like the end result to be is to have a column that has 5 items, which could change, and when the macro is run, it will bring in the current prices that lowes as on their website, and have those prices displayed in the column next to the item numbers

When you paste the code, you need to delete the part = "washer", and un-comment the application.inputbox line next to it. Should look like this: part = application.inputbox("What are we searching for at Lowes today? "Lowes Search",Type:=2)

As for the text, it sounds like the function is not getting called. . Which is weird because i tested it before i posted. Let me look real quick..