1

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

12
  • Try to automate IE and retrieve the necessary data from DOM, or to make XHR and parse response. Share URL and data description you need to extract for insight. Commented Jun 30, 2016 at 19:53
  • I'm not using IE at any stage in this process. My browser is FireFox. However no browser is called in the routine I want to create. I generate query in excel send it to the server. the response is returned from the web server side with PHP from MySQL database and streamed out via an Apache Server. Commented Jul 1, 2016 at 15:54
  • Actually web query does use Internet Explorer for its functionality. Although that's beside the point. I mean just to switch to another data scraping methods to achieve what you intend - get data directly to variable. So to get data from database you use ADODB, ODBC ActiveX (as in the above example), and from web page - IE or XHR ActiveX. Note there is no available ActiveX for FireFox. Commented Jul 1, 2016 at 16:24
  • Ok I get what your saying about using IE. My question was more related to your comment where I need some sample code using IE or XHR ActiveX. I'm not a VBA coder, so I assume you mean an ajax connection as it might be commonly referred to in other languages? Can you provide some code like that? Commented Jul 5, 2016 at 17:03
  • AJAX (Asynchronous JavaScript And Xml) is based on XHR (XMLHttpRequest). But it isn't necessary to use such powerful approach. I suggest simple synchronous HTTP POST or GET request, also we have VBA instead of JavaScript. As I wrote, please share URL and data description you need to extract for insight. Then I will be able to suggest a code. Commented Jul 5, 2016 at 19:34

1 Answer 1

2

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

Sign up to request clarification or add additional context in comments.

4 Comments

The 2nd option was the one I was looking for. I understand they do the same thing but using the more traditional AJAX construct is more familiar to me.
Question about option 1 "With CreateObject("InternetExplorer.Application")" Are you limited to InternetExplorer or would it be possible to call up the newer browser Edge. Edge more likely includes some of the more modern commands that let you parse the DOM with document.querySelector or document.querySelectorAll, which is akin to split() and gives you an instant array without having to walk the document nodes and using RegEx
@Claus, regarding Edge automation.
Thanks for those insightful references articles. You have given me the basis from which I can now build more complex apps.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.