linking IE to web query

iink · Oct 24, 2011

I have been delving through multiple websites to try and find some help with IE and web queries and linking them together and have failed to find anything directly related.

I use a web query to Download multiple pages at one time, however, the major problem is that i have to go into the data section log in to the site and then run the query. What I am trying to do is make it so that all I have to do it click a button and have it run completely without having to do the extra step... here is my code (this code runs in conjunction with a another piece that places it in a specific sheet):

Dim ieApp As InternetExplorer
Dim iedoc As Object
Dim ieTable As Object

Set ieApp = New InternetExplorer

ieApp.Visible = True

ieApp.navigate "insert url here"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

Set iedoc = ieApp.document

With iedoc.forms(0)
.username.Value = "username"
.password.Value = "password"
.submit.Click
End With
'ieApp.Quit
Application.CutCopyMode = False

Set New_Web_Query = dest.Parent.QueryTables.Add(Connection:="URL;" & URL, Destination:=dest)
With New_Web_Query
.Name = "web_query"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

I can get it to do each thing of code individually (as in I run the code and it runs IE, but it does not run the query), however, I am just not sure how to link them together. Help would be wonderful. Thank you in advance.

John_w · Oct 30, 2011

Maybe you can adapt this code:

http://www.tek-tips.com/faqs.cfm?fid=6400

iink · Nov 1, 2011

I tried using that code as is, it did not produce any results or error messages when I ran it. Ran to each "Stop" and did not go any further, tried multiple things to fix it to no avail.

This is the code I have been using :

Code:

Sub Get_Web_Query_Data2()
    
    Dim queryDestination As Range
    Dim i As Integer
    Dim lastRow As Long
    Dim cell As Range
    Dim qt As QueryTable
    
    'Destination sheet and cell for the web query.  The first web query data will be returned to cell A1 on Sheet3
    
    Set queryDestination = Sheets("Sheet3").Range("A1")
    
    'Delete all queries on query sheet
    
    With queryDestination.Parent
        For i = .QueryTables.Count To 1 Step -1
            .QueryTables(i).Delete
        Next
        .Cells.ClearContents
    End With
    
    With Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For Each cell In .Range("A2:A" & lastRow)
            Set qt = New_Web_Query(cell.Value, queryDestination)
            
            'Delete the web query and change the destination to the next column for the next query
            
            qt.Delete
            Set queryDestination = queryDestination.Offset(0, 1)
           
            DoEvents
        Next
        
    End With
    
End Sub


Private Function New_Web_Query(URL As String, dest As Range) As QueryTable
Dim ie As Object
Dim ipf As Object
Dim URL As String

URL = "http://dei.yieldstar.com/rms/po/main.do"

Set ie = CreateObject("InternetExplorer.Application")

    With ie
        .Visible = True
        .navigate "http://dei.yieldstar.com/rms/LoginFrame.jsp?client=dei"
         
        Do Until Not .Busy
            DoEvents
        Loop
        
        Set ipf = ie.document.all.Item("username")
        ipf.Value = "username here"
        Set ipf = ie.document.all.Item("password")
        ipf.Value = "password here"
        Set ipf = ie.document.all.Item("Submit")
        ipf.Value = "Submit"
        ipf.Click

        Do Until Not .Busy
            DoEvents
        Loop


    Set New_Web_Query = dest.Parent.QueryTables.Add(Connection:="URL;" & URL, Destination:=dest)
    With New_Web_Query
        .Name = "web_query"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

End Function

The IE coding I am using works on its own but does not draw in the web query. This is the direct URL: http://dei.yieldstar.com/rms/?client=dei

John_w · Nov 2, 2011

Try the following code instead of the web query to extract data from the web page:

Code:

Public Sub ExtractHTMLTable(HTMLdoc As Object, TableId_or_Index As Variant, DestinationCell As Range)

    'Extracts data from the specified HTML table id or number, and writes it to the worksheet starting at the specified
    'destination cell
    
    Dim table As Object, row As Object, cell As Object
    
    Set table = Nothing
    On Error Resume Next
    Set table = HTMLdoc.getElementsByTagName("TABLE")(TableId_or_Index)
    On Error GoTo 0
    
    If Not table Is Nothing Then
    
        'Fill rows and columns on the active sheet starting from the specified start cell
               
        For Each row In table.Rows
            For Each cell In row.Cells
                DestinationCell.Offset(row.RowIndex, cell.cellIndex).Value = cell.innerText
            Next
        Next
    
    End If
    
End Sub

Call it like this:

Code:

ExtractHTMLTable IE.document, 0, Sheets("Sheet1").Range("A1")
ExtractHTMLTable IE.document, "table_xyz", Sheets("Sheet1").Range("A4")

The 2nd argument is the table index (zero based) number or the table id string of the table you want to extract. Look at the HTML source to determine the correct index number or id, or use trial and error. The 3rd argument is the destination sheet and cell where you want the extracted data will start.

I can't really help further because that web site requires a username and password.

iink · Nov 3, 2011

Thank you for your help! I ended up finding a back way in accidentally, I still have to enter my login credentials, but that is not a huge problem.

linking IE to web query

iink

New Member

Excel Facts

John_w

MrExcel MVP

iink

New Member

John_w

MrExcel MVP

iink

New Member

Similar threads

Forum statistics

Share this page

linking IE to web query

iink

New Member

Excel Facts

John_w

MrExcel MVP

iink

New Member

John_w

MrExcel MVP

iink

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock