VBA - Extracting data from serverXMLHTTP.responsetext

C

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:

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
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"
 
Upvote 0
So you want the drawing number in one dimension of the array and the revision in the second dimension?
 
Upvote 0
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:
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Adding a custom message.
Replies
1
Views
426
Micron
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
N
  • Question
VBA - Pull Data from multiple closed Workbooks (if sheet names exist) using a date naming convention
Replies
1
Views
578
NGB82KS
N
K
  • Question
Need VBA help Cut and paste in to another locations if data and condition matches.
Replies
1
Views
681
Kishan
K
A
  • Question
Web Scraping using VBA
Replies
4
Views
9K
atr140
A

Forum statistics

Threads
1,214,827
Messages
6,121,817
Members
449,049
Latest member
cybersurfer5000

Share this page

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
Back
Top