Extract Data from Web Page without Tags

rsburge
rsburge used Ask the Experts™
on
I need to extract data from a web page using VBA.  I have everything working but when I get to the webpage, there is only a single number returned and I am not sure how to pull that number into a variable.  There are no tags to reference.

This is an example that I am working with.

https://192.168.1.242/act_pricerequest_count.cfm?LoanDate1=4/15/2018&LoanDate2=5/14/2018

I simply use IE.navigate "https://192.168.1.242/act_pricerequest_count.cfm?LoanDate1=4/15/2018&LoanDate2=5/14/2018" to get to this page.  I just need to know how to get the number returned, 62, into a variable of rngAutomated.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
No one outside your organisation can navigate to your posted internal IP address.

Author

Commented:
Sorry about that.

https://locks.platinumez.com/act_pricerequest_count.cfm?LoanDate1=4/15/2018&LoanDate2=5/14/2018

This number returned is 6817 and is just the number.
Most Valuable Expert 2015
Distinguished Expert 2018
Commented:
You can set a reference to "Microsoft XML, v6.0", then run something like this:

Public Function RetrieveDataResponse(ByVal ServiceUrl As String) As String

    ' ServiceUrl is expected to have URL encoded parameters.
    
    ' Fixed constants.
    Const Async             As Boolean = False
    Const StatusOk          As Integer = 200
    Const StatusNotFound    As Integer = 404
    
    Dim XmlHttp             As XMLHTTP60
    Dim ResponseText    As String
       
    Set XmlHttp = New XMLHTTP60
     
    XmlHttp.Open "GET", ServiceUrl, Async
    XmlHttp.send

    ResponseText = XmlHttp.ResponseText
    Select Case XmlHttp.status
        Case StatusOk
            ' Result = True
        Case StatusNotFound
            ' Result = False
    End Select
    
    RetrieveDataResponse = ResponseText

Exit_RetrieveDataResponse:
    Set XmlHttp = Nothing
    Exit Function

Err_RetrieveDataResponse:
    MsgBox "Error" & Str(Err.Number) & ": " & Err.Description, vbCritical + vbOKOnly, "Web Service Error"
    Resume Exit_RetrieveDataResponse

End Function

Open in new window

Why Diversity in Tech Matters

Kesha Williams, certified professional and software developer, explores the imbalance of diversity in the world of technology -- especially when it comes to hiring women. She showcases ways she's making a difference through the Colors of STEM program.

Author

Commented:
I added this to my project and added Microsoft XML 6.0 to the references, but when I try to run it, it brings up the box that asks which macro I want to run.

I must be doing something wrong.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
Can't tell, but it is air code - a simplified version of what I am using here:

VBA.CVRAPI

in the function RetrieveDataResponse  to pull some Json data - these are effectively just one long string.
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
I added this to my project and added Microsoft XML 6.0 to the references, but when I try to run it, it brings up the box that asks which macro I want to run.

This a Function with argument and should be called from another macro.
It seems, you placed the cursor inside the function and tried to run it.
When calling this function from another macro, you need to pass target URL as a parameter.
e.g. the following code calls this function.

Sub CallFunction()
Dim URL As String
Dim WebStr As String
URL = "https://locks.platinumez.com/act_pricerequest_count.cfm?LoanDate1=4/15/2018&LoanDate2=5/14/2018"
WebStr = RetrieveDataResponse(URL)
MsgBox WebStr
End Sub

Open in new window

Author

Commented:
I apologize for the delay, I was out of the office doing training and was unable to get back to this until today.  This is working exactly as needed now.  Thank you very much!
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
No problem. Have a nice weekend!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial