Import data from website

**Excel Fox** · 04-20-2012, 03:55 PM

Another method. ENSURE that you have a sheet named DataSheet in your workbook.

Code:

'ASSUMPTION: THE HOST SYSTEM HAS INTERNET EXPLORER VERSION 5 OR GREATER INSTALLED
Option Explicit
Const strURLMain = "http://www.nseindia.com/live_market/...segmentLink=17"
Sub ItemNumberArticleLookUp()
 
    Dim IE As Object 'InternetExplorer
    Dim htmDocument As Object 'htmlDocument
    Dim strFile As String
    Dim ihtmlTableSection As Object 'HTMLTableSection
   
    Dim lngLoop As Long
      
ErrH:
    Err.Clear: On Error GoTo -1: On Error GoTo 0: On Error GoTo ErrH
    If Not IE Is Nothing Then
        lngLoop = lngLoop + 1
        If lngLoop > 5 Then
            MsgBox "Unable to continue!", vbOKOnly, "Cyclic Error"
            Exit Sub
        End If
        IE.Quit
        Set IE = Nothing
    End If
   
    'Start the internet explorer
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    'Navigate to the main URL
    IE.Navigate strURLMain
    'Hold your horses (so to say) till the page is ready :) [Ditto wherever used]
    IESTATUS IE
    Set htmDocument = IE.Document
    Set ihtmlTableSection = htmDocument.getElementsByTagName("TBODY")(2)
    strFile = ThisWorkbook.Path & "\NSE.htm"
    lngLoop = FreeFile()
    Open strFile For Output As lngLoop
    Print #lngLoop, ihtmlTableSection.parentElement.parentElement.outerHTML
    Close #lngLoop
    ThisWorkbook.Sheets("DataSheet").UsedRange.Clear
    With Workbooks.Open(strFile).Sheets(1)
        .Pictures.Delete
        .UsedRange.Columns(1).Offset(1).Clear
        .UsedRange.Columns(.UsedRange.Columns.Count).Offset(1).Clear
        .UsedRange.Copy ThisWorkbook.Sheets("DataSheet").Cells(1)
        .Parent.Close 0
    End With
    Kill strFile
    With ThisWorkbook.Sheets("DataSheet")
        .UsedRange.EntireColumn.AutoFit
        lngLoop = .Cells(1).MergeArea.Columns.Count
        .Cells(1).MergeArea.UnMerge
        .Cells(1, 2).Value = .Cells(1).Value
        .Columns(1).Delete
        .Cells(1).Resize(1, lngLoop - 1).Merge
        With .Cells(1).End(xlToRight)
            lngLoop = .MergeArea.Columns.Count
            .MergeArea.UnMerge
            .Resize(1, lngLoop - 1).Merge
        End With
        Application.Goto .Cells(1)
    End With
    IE.Quit
    Set IE = Nothing
    Exit Sub
ErH:
    MsgBox Err.Description, vbCritical + vbOKOnly, "Unexpected Error"
    IE.Quit
   
End Sub
Private Sub IESTATUS(ByVal IE As Object)
 
    Do While IE.Busy = True: Loop
    Do Until IE.readystate = 4: Loop
    Application.Wait Now() + TimeValue("00:00:01")
   
End Sub