• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

unable to export data from current open web page using vba

gandhi_amt

New Member
I want to automate my delivery status for my regular courier from various service provider like Blue Dart.

I have Docket Numbers; I tried the same using VBA but it is unable to fetch data from webpage.

My code enter the Docket number from cell in home page, then it redirects to other page where delivery status is mentioned in table.

Eg of Docket Number for tracking 50419480764 or 50419669171; I am not getting any error but it even doesn't fetch the data as if it is blank.

Code:
Sub GetCourseList()

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")

Dim IEWindows          As SHDocVw.ShellWindows
Dim IEwindow            As SHDocVw.InternetExplorer
Dim IEDocument          As MSHTML.HTMLDocument
Dim BreadcrumbDiv      As MSHTML.HTMLElementCollection

Set IEWindows = New SHDocVw.ShellWindows

'create new instance of IE. use reference to return current open IE if
'you want to use open IE window. Easiest way I know of is via title bar.
  IE.Navigate "http://www.bluedart.com/maintracking.html"
'go to web page listed inside quotes
  IE.Visible = True
  While IE.busy
    DoEvents  'wait until IE is done loading page.
  Wend
  IE.Document.All("numbers").Value = ThisWorkbook.Sheets("sheet1").Range("A1")
  Application.SendKeys "~"

    Dim URL As String
    Dim qt As QueryTable
    Dim ws As Worksheet

    Set ws = Worksheets.Add
    For Each IEwindow In IEWindows
    If InStr(IEwindow.LocationURL, "your URL or some unique string") <> 0 Then  ' Found it
    Set IEDocument = IEwindow.Document

    URL = IEwindow.LocationURL

    Set qt = ws.QueryTables.Add( _
    Connection:="URL;" & URL, _
    Destination:=Range("F1"))

        With qt
        .RefreshOnFileOpen = True
        .Name = "bluedart"
        .FieldNames = True
        .WebSelectionType = xlAllTables
        .Refresh BackgroundQuery:=False

    End With
End If
Next
End Sub
 
Back
Top