CODEWITHSUNDEEP
vbaexcelinternet-explorerweb-scrapingxmlhttprequest
Claus
Claus

Reputation: 550

Importing web query data into a VBA variable instead of excel spreadsheet cell

I wish to perform a web query from my excel spreadsheet. However I do not want to display the data on the worksheet. I want to store it directly into a VBA array.

I found this example on the internet Return Sql Query Results To Vba Variable Instead Of Cell

Here is the coded solution from the link with an ODBC connection. I would like to adapt this to a web query solution. Not sure how to modify it.

Dim ws As Workspace, db As Database, rs As Recordset 
Dim sqlstr As String, ToolID As String 

Private Sub OpenODBC(ws As Workspace, db As Database, dsn As String, id  As String, pwd As String) 
  Dim dsnStr As String 
  Set ws = CreateWorkspace("ODBCWorkspace", "", "", dbUseODBC) 
  Workspaces.Append ws 
  ws.LoginTimeout = 300 
  dsnStr = "ODBC;DSN=" & dsn & ";UID=" & uid & ";PWD=" & pwd 
  Set db = ws.OpenConnection(dsn, dbDriverNoPrompt, False, dsnStr) 
  db.QueryTimeout = 1800 
End Sub 

Sub Tool() 

  On Error Goto errhandler: 

  Call OpenODBC(ws, db, "AC", "USERNAME", "PASSWORD") 

  sqlstr = "SELECT FHOPEHS.LOT_ID, FHOPEHS.TOOL_ID" & Chr(13) & "" & Chr(10) & "FROM DB2.FHOPEHS FHOPEHS" & Chr(13) & "" & Chr(10) & "WHERE (FHOPEHS.LOT_ID='NPCC1450.6H') AND (FHOPEHS.TOOL_ID Like 'WPTMZ%')" 

  Set rs = db.OpenRecordset(sqlstr, dbOpenSnapshot) 

  ToolID = rs("TOOL_ID") 

  Goto ending 

  errhandler: 
  If Err.Number = 1004 Then 
      Goto ending 
  End If 
  ending: 

  MsgBox ToolID 

End Sub

I do not have an external link to share, this is an intranet, but below is my code which I'm trying to modify to store the result in an array instead of a worksheet cell - As shown below in my code the destination is cell "A1" on the worksheet.

The initial example I posted shows how to store the data directly in the variable "Set rs = db.OpenRecordset(sqlstr, dbOpenSnapshot) ".

Other solutions I found on the net, store the data to location on a worksheet and then move it into an array, completing the action with deleting the content on the worksheet. I'm not interested in doing that procedure, I wish to go directly into the variable from the query result.

    Sheets("Raw Data").Select

Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://myInternalAddress/myServerSideApp.php", Destination:=Range("A1"))
    .Name = "AcctQry"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

The expected result will be a list of names and their initials

The php code streaming out the data looks like this

    function getEngineers()
    {
        $sql = 'select `engname` as `name`, `engineer` as `initials` from `engineers`';
        if ( $result = $db->query($sql) )
        {
            if ($result->num_rows > 0)
            {
?>
                    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
                    <html lang="en">
                        <head></head>
                        <body>
                            <table>
                                <tbody>
<?php
                                    while ($n = $result->fetch_array()) 
                                    {
                                        echo '<tr><td>'.$n['name'].'</td><td>'.$n['initials'].'</td></tr>';
                                    }
?>
                                </tbody>
                            </table>

                        </body>
                    </html>
<?php
            }else{
                throw new Exception('No names returned');
            }
        }else{
            throw new Exception("Query to get engineer's names failed");
        }
    }

Here is the output from the browser. Basically there are two columns, 1. the name, 2. the initials

enter image description here

Ok here is the screen shot of the HTML code, nothing unique Screen shot of html output

Upvotes: 1

Views: 2881

Answers (1)

omegastripes
omegastripes

Reputation: 12612

Here are the examples showing how to automate IE and retrieve the data from DOM, and to make XHR and parse response.

The sample for testing is as follows:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html lang="en">
    <head></head>
    <body>
        <table>
            <tbody>
                <tr><td>Miggs, Thomas </td><td>TJM</td></tr>
                <tr><td>Nevis, Scott </td><td>SRN</td></tr>
                <tr><td>Swartz, Jeff </td><td>JRS</td></tr>
                <tr><td>Manner, Jack </td><td>JTM</td></tr>
                <tr><td>Muskey, Timothy </td><td>TMM</td></tr>
                <tr><td>Koeller, Steven </td><td>SRK</td></tr>
                <tr><td>Masters, Jeff </td><td>JLM</td></tr>
            </tbody>
        </table>
    </body>
</html>

I placed it by the link to make it accessible for debug purposes.

The code to automate IE and retrieve the necessary data from DOM:

Sub TestIE()

    Dim aRes As Variant
    Dim i As Long

    With CreateObject("InternetExplorer.Application")
        ' Make visible for debug
        .Visible = True
        ' Navigate to page
        .Navigate "https://pastebin.com/raw/YGiZ3tyk"
        ' Wait for IE ready
        Do While .ReadyState <> 4 Or .Busy
            DoEvents
        Loop
        ' Wait for document complete
        Do While .Document.ReadyState <> "complete"
            DoEvents
        Loop
        ' Wait for target table accessible
        Do While .Document.getElementsByTagName("table").Length = 0
            DoEvents
        Loop
        ' Process target table
        With .Document.getElementsByTagName("table")(0)
            ' Create 2d array
            ReDim aRes(1 To .Rows.Length, 1 To 2)
            ' Process each table row
            For i = 1 To .Rows.Length
                With .Rows(i - 1).Cells
                    ' Assign cells content to array elements
                    aRes(i, 1) = .Item(0).innerText
                    aRes(i, 2) = .Item(1).innerText
                End With
            Next
        End With
        .Quit
    End With

End Sub

The code to make request with XHR and parse response with RegEx:

Sub TestXHR()

    Dim sRespText As String
    Dim aRes As Variant
    Dim i As Long

    With CreateObject("MSXML2.ServerXMLHttp")
        .Open "GET", "https://pastebin.com/raw/YGiZ3tyk", False
        .Send
        sRespText = .responseText
    End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "<tr><td>([\s\S]*?)</td><td>([\s\S]*?)</td></tr>"
        ' Get matches collection
        With .Execute(sRespText)
            ' Create 2d array
            ReDim aRes(1 To .Count, 1 To 2)
            ' Process each match
            For i = 1 To .Count
                ' Assign submatches content to array elements
                With .Item(i - 1)
                    aRes(i, 1) = .SubMatches(0)
                    aRes(i, 2) = .SubMatches(1)
                End With
            Next
        End With
    End With

End Sub

Both methods gives the same result in aRes array on the last line break point:

result

Upvotes: 2

Related Questions