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 (http://www.ebay.com/itm/DELL-D620-CORE-2-DUO-1-66GHZ-LAPTOP-40GB-WIFI-1GB-OFFICE-WIN-XP-CHEAP-/160684297063?pt=Laptops_Nov05&hash=item256987cb67)
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