Capture values from IE page

[maruthi]

Hi guys,
I am looking to capture price, Shipping values to from below mentioned site
DELL D620 CORE 2 DUO 1.66GHZ LAPTOP 40GB WIFI 1GB OFFICE WIN XP CHEAP | eBay
values has to be captured offset of active cell like 0,5 and 0,6

[littleiitin]

Hi Maruthi,

Welcome to the board,

Please find attached file for your solution.



Thanks
Rahul Singh

[maruthi]

Thanq very much Rahul Singh

[maruthi]

Hi rahul,

a small alteration we cannot give url every time. we have to fetch data such a way that
it has to got active window of internet explorer and then it has to fetch values from there.
clearly means we will be in excel when we run the macro(VBA) it has to navigate to already opened website and copy values from there. i have code for window navigate please check it out
On Error Resume Next
AppActivate "Windows Internet Explorer"
will be waiting for your early reply.
Thanks in advance
Regards,
Maruthi

[maruthi]

Can you help me out please

[littleiitin]

Maruthi,

Please always mention all links for cross posts, so that if solution is already provided others would not try.
Please mention all the cross post links first.

[littleiitin]

Hi Maruti,

Please Replace original code with below one I believe this will solve your problem:

Public Sub InkWeb()
    
    Dim MyPost                  As String
    Dim MyUrl                   As String
    Dim PostUser                As String
    Dim PostPassword            As String
    Dim wbkTemp                 As Workbook
    Dim strPrice                As String
    Dim strShipChar             As String
    Dim IEwindow                As SHDocVw.InternetExplorer
    Dim allExplorerWindows      As New SHDocVw.ShellWindows
    Dim rngPaste                As Range
    Dim rngPrice                As Range
    Dim rngShipping             As Range
    Dim rngBML                  As Range
    Application.ScreenUpdating = False
    Set allExplorerWindows = New SHDocVw.ShellWindows
    For Each IEwindow In allExplorerWindows
        
        MyUrl = IEwindow.LocationURL
        If InStr(1, MyUrl, "ebay") > 0 Then
            Set wbkTemp = Workbooks.Add(1)
            With wbkTemp.Worksheets("sheet1").QueryTables.Add(Connection:="URL;" & MyUrl, Destination:=Cells(5, 1))
                .PostText = MyPost
                .BackgroundQuery = True
                .TablesOnlyFromHTML = True
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
            With wbkTemp.Worksheets("Sheet1")
                Set rngPrice = .Cells.Find("Price:", , , xlWhole)
                strPrice = rngPrice.Offset(, 1)
                On Error Resume Next
                    Set rngShipping = .Cells.Find("Shipping:", , , xlWhole)
                    
                    'Set rngBML = .Cells.Find("Bill Me Later", , , xlPart)
                    strShipChar = rngShipping.Offset(, 1)

                On Error GoTo 0
            End With
            wbkTemp.Close 0
            Set wbkTemp = Nothing
            With ThisWorkbook.Worksheets("FetchData")
                If .Range("rngPrice").Value <> "" Then
                    If .Range("rngPrice").End(xlDown).Row <> .Rows.Count Then
                        Set rngPaste = .Range("rngPrice").End(xlDown).Offset(1)
                    Else
                        Set rngPaste = .Range("rngPrice").Offset(1)
                    End If
                    rngPaste.Value = strPrice
                    rngPaste.Offset(, 1).Value = strShipChar
                Else
                    MsgBox "Please set the Header ""Price"" in Cell B6", vbInformation
                    Exit Sub
                End If
            End With
        End If
        
    Next

    Application.ScreenUpdating = True
End Sub