VBA - Extracting data from serverXMLHTTP.responsetext

cbrf23

Board Regular
Joined
Jun 20, 2011
Messages
241
Hi all,

I'm using VBA to do work with data I'm pulling from ASP forms from our intranet site.
I'd like to build a 2d array from the html table that is returned. I'm wondering what the best way is to do that.
Here is the procedure I created: (myurl and method arguments should be self explanatory)

Code:
Private Sub httpOpen(ByVal myurl As String, Optional ByVal Method As String)
       If Not Len(Method) > 0 Then Method = "GET" Else Method = UCase(Method)
    Dim http As Object
    Dim strX As String
    

    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    http.open Method, myurl, False
    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    http.send (myurl)
    strX = http.responseText
    Debug.Print strX
    TestParse strX, strFiltDrawNum
End Sub

The responseText looks like this, and I want to pull "drawing" and "rev" parameters from each result and pass them to a 2D array.
I'm wondering what the best way to do this would be.
I'm just not very familiar with manipulating html data.

HTML:
<html>
<head>
<title>Freight Drawing List</title>
</head>
<body text="#000000" link="#F20000" vlink="#A70101" alink="#C1A100">

<p> </p>
<font size="+2"><b>
<p>Drawing List - Query Results</b></font>.</p>
<p>(Status = All) </p>
<table border="1" cellpadding="5" cellspacing="0">
  <tr>
    <th>Image</th>
    <th>Size</th>
    <th>Drawing<br><font face="ARIAL" size=-3>click link for detail</font></th>
    <th>Type</th>
    <th>Rev</th>
    <th>Sheet No.</th>
    <th>Status</th>
    <th>Charged Out By:</th>
    <th>Description</th>
    <th>Edit</th>
  </tr>
  <tr>
    <td align="CENTER">
    
        <a href="root/company/8888888C.PDF">Image</a>
    
    </td>
    <td align="CENTER">B </td>
    <td align="CENTER" nowrap><a href="drawdet.asp?drawnum=8888888&rev=C&pagenum=1&dwg_type=Eng">8888888</a></td>
    <td align="CENTER"> </td>
    <td align="CENTER">C </td>
    <td align="center"><a href="root/company/8888888C.PDF">1</a> </td>
    <td align="CENTER">Active </td>
    <td align="CENTER">  </td>
    <td>LTCS-P12-FLNG300-FRG-MACH</td>
    <td align="CENTER"><a href="drawedit.asp?drawnum=8888888&rev=C&pagenum=1&dwg_type=Eng">Edit</a></td>
  </tr>
  <tr>
    <td align="CENTER">
    
        <a href="root/company\8888888B.PDF">Image</a>
    
    </td>
    <td align="CENTER">B </td>
    <td align="CENTER" nowrap><a href="drawdet.asp?drawnum=8888888&rev=B&pagenum=1&dwg_type=Eng">8888888</a></td>
    <td align="CENTER"> </td>
    <td align="CENTER">B </td>
    <td align="center"><a href="root/company\8888888B.PDF">1</a> </td>
    <td align="CENTER">Obsolete </td>
    <td align="CENTER">  </td>
    <td>LTCS-P12-FLNG300-FRG-MACH</td>
    <td align="CENTER"><a href="drawedit.asp?drawnum=8888888&rev=B&pagenum=1&dwg_type=Eng">Edit</a></td>
  </tr>
  <tr>
    <td align="CENTER">
    
        <a href="root/company/8888888A.PDF">Image</a>
    
    </td>
    <td align="CENTER">B </td>
    <td align="CENTER" nowrap><a href="drawdet.asp?drawnum=8888888&rev=A&pagenum=1&dwg_type=Eng">8888888</a></td>
    <td align="CENTER"> </td>
    <td align="CENTER">A </td>
    <td align="center"><a href="root/company/8888888A.PDF">1</a> </td>
    <td align="CENTER">Obsolete </td>
    <td align="CENTER">  </td>
    <td>LTCS-P12-FLNG300-FRG-MACH</td>
    <td align="CENTER"><a href="drawedit.asp?drawnum=8888888&rev=A&pagenum=1&dwg_type=Eng">Edit</a></td>
  </tr>
  <tr>
    <td align="CENTER">
    
        <a href="root/company/8888888.PDF">Image</a>
    
    </td>
    <td align="CENTER">B </td>
    <td align="CENTER" nowrap><a href="drawdet.asp?drawnum=8888888&rev=-&pagenum=1&dwg_type=Eng">8888888</a></td>
    <td align="CENTER"> </td>
    <td align="CENTER">- </td>
    <td align="center"><a href="root/company/8888888.PDF">1</a> </td>
    <td align="CENTER">Obsolete </td>
    <td align="CENTER">  </td>
    <td>LTCS-P12-FLNG300-FRG-MACH</td>
    <td align="CENTER"><a href="drawedit.asp?drawnum=8888888&rev=-&pagenum=1&dwg_type=Eng">Edit</a></td>
  </tr>
</table>
<p>
<p>
<a href="drawsrchres.asp?drawnum=8888888&dwg_type=Eng&ts=2">Click here to search for additional statuses (secured)</a>
<p><a HREF="file:\\wsd5\apps01\multiprint\multiman.exe">MultiPrint</a></p>


</body>
</html>
 
Last edited:

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

mjbeam

Well-known Member
Joined
Apr 6, 2002
Messages
756
The drawing is always blank (&nbsp) in your example html above. Is this correct?
 

cbrf23

Board Regular
Joined
Jun 20, 2011
Messages
241
No, drawing is always a hyperlink to the "drawdet.asp" details page. Its always the third column in the table.
First column=link to PDF image, text="image"
Second=drawing page size
Third=link to drawing details ASP form, text=drawing number
Fourth=drawing type (always blank in the example)
Fifth=revision
Sixth=sheet number (always 1 in the example)
Seventh=Status
Eighth=Charged out by (always blank in the example)
Ninth=Description
Tenth=Link to edit details ASP form, text="Edit"
 

mjbeam

Well-known Member
Joined
Apr 6, 2002
Messages
756
So you want the drawing number in one dimension of the array and the revision in the second dimension?
 

mjbeam

Well-known Member
Joined
Apr 6, 2002
Messages
756

ADVERTISEMENT

Code:
    strX = Mid(strX, InStr(strX, "< /tr>") + 1) 'Throw out the header
    
    'Count number of rows in strX
    c = 0
    i = 1
    While InStr(i, strX, "< tr>") > 0
        c = c + 1
        i = InStr(i, strX, "< tr>") + 1
    Wend
    ReDim strX_Array(c, 2)
    c = 0
    While InStr(strX, "< tr>") > 0
        c = c + 1
        'Skip Image and Size to get to Drawing
        strX = Mid(strX, InStr(strX, "< td") + 1)
        strX = Mid(strX, InStr(strX, "< td") + 1)
        strX = Mid(strX, InStr(strX, "< td") + 1)
        strX = Mid(strX, InStr(strX, ">") + 1)
        strX = Mid(strX, InStr(strX, ">") + 1)
        strX_Array(c, 1) = Left(strX, InStr(strX, "<") - 1)
        'Skip Type to get to Rev
        strX = Mid(strX, InStr(strX, "< td") + 1)
        strX = Mid(strX, InStr(strX, "< td") + 1)
        strX = Mid(strX, InStr(strX, ">") + 1)
        strX_Array(c, 2) = Left(strX, InStr(strX, "<") - 1)
        If InStr(strX_Array(c, 2), "&") > 0 Then strX_Array(c, 2) = Left(strX_Array(c, 2), InStr(strX, "&") - 1)
        strX = Mid(strX, InStr(strX, "< /tr>"))
    Wend

*NOTE: You will have to remove the spaces from these strings: "< td", "< /tr>", "< tr>". They wouldn't display properly so I had to insert a space.
 
Last edited:

cbrf23

Board Regular
Joined
Jun 20, 2011
Messages
241
That was my first thought, use string functions to parse the data, but I'm thinking it would be more efficient to create and HTMLDocument from the responseText and then directly access the table element.
I'm just not sure how to do this.
I tried .getElementsByTagName("table") but that did not work.
e.g. in the example below, the "table" variable doesn't populate. No error is thrown, it just doesn't populate

When I query the immediate window with ?doc.getElementsByTagName("table").length it returns 0, so it's not even picking up the table.

Code:
Private Sub httpOpen(ByVal myurl As String, Optional ByVal Method As String)
       If Not Len(Method) > 0 Then Method = "GET" Else Method = UCase(Method)
    Dim http As Object
    Dim strX As String
    Dim doc As MSHTML.HTMLDocument
    Dim table As MSHTML.HTMLTable
    
    Set doc = New MSHTML.HTMLDocument

    Set http = CreateObject("MSXML2.ServerXMLHTTP")
        With http
            .open Method, myurl, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send (myurl)
            strX = .responseText
        End With
    'Debug.Print strX
    
    Set table = doc.getElementsByTagName("table")(0)
    With table
        Debug.Print .rows(1).cells(1).innerText
    End With
 
Last edited:

cbrf23

Board Regular
Joined
Jun 20, 2011
Messages
241
I realized I had deleted a line of code that was important. So I fixed it. I'm now able to grab the table and should be able to pass the table data to an array simply.
Thanks for all the help MJBeam!

The code snippet I was missing was:
Code:
doc.Body.innerHTML = http.responseText
 

cbrf23

Board Regular
Joined
Jun 20, 2011
Messages
241
Here's where I got with it, and so far so good.

Would be nice if there was a direct way to populate the array from the html table, but this is pretty quick in execution.

Code:
Private Function HttpOpen(ByVal strArgURL As String, Optional ByVal strArgMethod As String)
       If Not Len(strArgMethod) > 0 Then strArgMethod = "GET" Else strArgMethod = UCase(strArgMethod) 
    Dim oHttp As Object
    Dim strX As String
    Set oHttp = CreateObject("MSXML2.ServerXMLHttp")
        With oHttp
            .open strArgMethod, strArgURL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send (strArgURL)
            strX = .responseText
            .abort
        End With
    HttpOpen = strX
    'Debug.Print strX
    
End Function
Sub TestDwgListQuery()
    Dim myurl As String
    Dim doc As MSHTML.HTMLDocument
    Dim table As MSHTML.HTMLTable
    Dim strX() As String
    
    
    myurl = "[URL]http://myserver/myfolder/drawlist1.asp?dwg_no=8888888&dwg_type=Eng&status=All[/URL]"
    
    Set doc = New MSHTML.HTMLDocument
    doc.Body.innerHTML = HttpOpen(myurl, "GET")
    Set table = doc.getElementsByTagName("table")(0)
    strX = tableFOO(table)
End Sub
Private Function tableFOO(ByRef tblArgX As MSHTML.HTMLTable) As String()
    Dim tblX As MSHTML.HTMLTable
    Dim celX As MSHTML.HTMLTableCell
    Dim rowX As MSHTML.HTMLTableRow
    Dim lngX As Long
    Dim lngY As Long
    Dim varX() As String
    
    Set tblX = tblArgX
    
    ReDim varX(0 To tblX.rows.Length - 1, 0 To tblX.rows(index:=0).cells.Length) '1 less than the number of rows in table because dont want header row
    
        For Each rowX In tblX.rows
            lngX = rowX.rowIndex
                If lngX > 0 Then
                        For Each celX In rowX.cells
                            lngY = celX.cellIndex
                            varX(lngX - 1, lngY) = celX.innerText
                            Debug.Print "VARX(" & lngX - 1 & "," & lngY & ")=  " & varX(lngX - 1, lngY)
                        Next celX
                End If
            lngX = 0
        Next rowX
        
    tableFOO = varX
End Function
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,233
Messages
5,594,963
Members
413,954
Latest member
mrsandy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top