Thread: How to fetch the table from ASP web site and save in Excel

We have a search tool web site (.aspx), which will give the list of policy data in a table format (Rows & Columns) upon clicking submit button. i want to fetch the entire table and have to save that in a excel. I have already wrote the code for opening the web site and clicking submit botton. I have attached the source code of the web site in this thread. Can anyone give me the sample code to fetch the entire 12th table of the web site and save it in the excel worksheet. Thanks for your help.

Please remember that, i have to include your sample in the below query. So please provide the code which fit into this.

Sub Button1_Click() 
Dim obj As Object 
Dim Scrn As String 
Dim objIE 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 

Set objIE = New SHDocVw.InternetExplorer

If (objIE Is Nothing) Then 
MsgBox "Could not create the Internet Explorer object. Stopping macro playback." 
Stop 
End If 

With objIE 
.Navigate "http://devts296:81/spiqatools/ui/PolicyFinder.aspx" ' Main page

.Visible = 1 
Do While .readyState <> 4: DoEvents: Loop 
Application.Wait (Now + TimeValue("0:00:02"))
Set htmlDoc = .document 
objIE.document.getElementById("LOBList").Value = "A" 
objIE.document.getElementById("DataFilterEnv").Value = "L" 
objIE.document.getElementById("ctl04_rdbAutoTransitionSignal_1").Checked = True objIE.document.getElementById("ctl04_AutoTransitionSignal").Value = "L" 
objIE.document.getElementById("btnsubmit").Click 

While objIE.Busy 
DoEvents 
Wend 
While objIE.readyState <> 4 
DoEvents 
Wend 

End With 

End Sub

Hello Rajen87,

Welcome to the Forum!

I have attached a file that shows the table that I believe you are referring to. Please have a look and let me know if this the table you want to import. Do want just the text or text and links copied to the worksheet?

Hello Rajen87,

I will copy only the text. Was the picture I posted of the correct table? Where should the text be copied to on the worksheet?

Hello Rajen87,

Here is the modified macro. If you have any problems, let me know.

' Thread:  http://www.excelforum.com/excel-programming/807655-how-to-fetch-the-table-from-asp-web-site-and-save-in-excel.html
' Poster:  rajen87
' Written: January 02, 2012
' Author:  Leith Ross

Sub Button1_Click()

    Dim C As Long
    Dim Cell As Object
    Dim Data As Variant
    Dim obj As Object
    Dim R As Long
    Dim Rng As Range
    Dim Scrn As String
    Dim TableX As Object
    Dim Text As String
    Dim Wks As Worksheet

    Dim objIE 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

        Set objIE = New SHDocVw.InternetExplorer

        If (objIE Is Nothing) Then
           MsgBox "Could not create the Internet Explorer object. Stopping macro playback."
           Stop
        End If

            With objIE
                .Navigate "http://devts296:81/spiqatools/ui/PolicyFinder.aspx" ' Main page
                .Visible = 1
            
                Do While .ReadyState <> 4: DoEvents: Loop
                Application.Wait (Now + TimeValue("0:00:02"))
            
                Set htmlDoc = .document
                objIE.document.getElementById("LOBList").Value = "A"
                objIE.document.getElementById("DataFilterEnv").Value = "L"
                objIE.document.getElementById("ctl04_rdbAutoTransitionSignal_1").Checked = True
                objIE.document.getElementById("ctl04_AutoTransitionSignal").Value = "L"
                objIE.document.getElementById("btnsubmit").Click

            While objIE.Busy Or objIE.ReadyState <> 4: DoEvents: Wend
            End With
            
            Set TableX = objIE.document.getElementById("GridView1")
            
            R = TableX.Rows.Length - 2
            ReDim Data(1 To R, 1 To 15)
            
            For R = 1 To TableX.Rows.Length - 2
                For C = 0 To 14
                    Text = ""
                    Set Cell = TableX.Rows(R).Cells(C)
                    If Not Cell Is Nothing Then
                       If Cell.HasChildNodes Then
                          Select Case Cell.ChildNodes(0).NodeName
                             Case Is = "A"
                                 Text = Cell.ChildNodes(0).innerHTML
                             Case Is = "#text"
                                 Text = Cell.innerHTML
                          End Select
                       End If
                       If InStr(1, Text, "<br>", vbTextCompare) Then
                          Data(R, C + 1) = Replace(Text, "<br>", vbLf, 1, -1, vbTextCompare)
                       Else
                          Data(R, C + 1) = Text
                       End If
                    End If
                Next C
            Next R
            
        Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        Wks.Name = "Policy Info"
        
        With Wks.Range("A1:O1").Resize(RowSize:=UBound(Data))
            .Value = Data
            .Rows(1).Font.Bold = True
            .VerticalAlignment = xlVAlignTop
            .HorizontalAlignment = xlHAlignCenter
            .Columns.AutoFit
        End With

End Sub

Hello Raj,

This problem occurs often with Internet Explorer. Excel often gets ahead of Internet Explorer in processing. I have added a 2 second delay to the macro before it begins processing the document object. Replace the old macro with the code below.

' Thread:  http://www.excelforum.com/excel-programming/807655-how-to-fetch-the-table-from-asp-web-site-and-save-in-excel.html
' Poster:  rajen87
' Written: January 02, 2012
' Updated: January 04, 2012
' Author:  Leith Ross

Sub Button1_Click()

    Dim C As Long
    Dim Cell As Object
    Dim Data As Variant
    Dim obj As Object
    Dim R As Long
    Dim Rng As Range
    Dim Scrn As String
    Dim TableX As Object
    Dim Text As String
    Dim Wks As Worksheet

    Dim objIE 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

        Set objIE = New SHDocVw.InternetExplorer

        If (objIE Is Nothing) Then
           MsgBox "Could not create the Internet Explorer object. Stopping macro playback."
           Stop
        End If

            With objIE
                .Navigate "http://devts296:81/spiqatools/ui/PolicyFinder.aspx" ' Main page
                .Visible = 1
            
              ' Wait for 2 seconds to allow the document object to be loaded.
                Application.Wait (Now + TimeValue("0:00:02"))
            
                Do While .ReadyState <> 4: DoEvents: Loop
                Application.Wait (Now + TimeValue("0:00:02"))
            
                Set htmlDoc = .document
                objIE.document.getElementById("LOBList").Value = "A"
                objIE.document.getElementById("DataFilterEnv").Value = "L"
                objIE.document.getElementById("ctl04_rdbAutoTransitionSignal_1").Checked = True
                objIE.document.getElementById("ctl04_AutoTransitionSignal").Value = "L"
                objIE.document.getElementById("btnsubmit").Click

            While objIE.Busy Or objIE.ReadyState <> 4: DoEvents: Wend
            End With
            
            Set TableX = objIE.document.getElementById("GridView1")
            
          ' Wait for 2 seconds to allow the document object to be loaded.
            Application.Wait (Now + TimeValue("0:00:02"))
            
            R = TableX.Rows.Length - 2
            ReDim Data(1 To R, 1 To 15)
            
            For R = 1 To TableX.Rows.Length - 2
                For C = 0 To 14
                    Text = ""
                    Set Cell = TableX.Rows(R).Cells(C)
                    If Not Cell Is Nothing Then
                       If Cell.HasChildNodes Then
                          Select Case Cell.ChildNodes(0).NodeName
                             Case Is = "A"
                                 Text = Cell.ChildNodes(0).innerHTML
                             Case Is = "#text"
                                 Text = Cell.innerHTML
                          End Select
                       End If
                       If InStr(1, Text, "<br>", vbTextCompare) Then
                          Data(R, C + 1) = Replace(Text, "<br>", vbLf, 1, -1, vbTextCompare)
                       Else
                          Data(R, C + 1) = Text
                       End If
                    End If
                Next C
            Next R
            
        Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        Wks.Name = "Policy Info"
        
        With Wks.Range("A1:O1").Resize(RowSize:=UBound(Data))
            .Value = Data
            .Rows(1).Font.Bold = True
            .VerticalAlignment = xlVAlignTop
            .HorizontalAlignment = xlHAlignCenter
            .Columns.AutoFit
        End With

End Sub

I think you'd better use a HTTPRequest.
BTW is the address correct ??

Hello Raj,

The macro was created and tested using the HTML file you posted. I am using Internet Explorer 8. If you are using a different version that may be the cause. The code in question is standard and runs on all browsers. However, I am unable to reproduce the error on my system. Since the last update changed nothing then something else is at work. What that may be is difficult to say since this is being run on private network that I know nothing about nor have access to.

Hello Raj,

I must not understand what you want to do. Active server pages simply create HTML documents that are sent to the browser. The server side scripts create the HTML document when the ASP file is executed. Provided that the information in the example HTML file is the same as that generated by your ASP file, the code should work.

Do you have the necessary network permissions to run the macro and this file on your network?
Does the table named "GridView1" exist in your ASP file code?

If you are not certain about the last question then open the ASP file using Notepad. Use CTRL+F to search for "GridView1" in the file.