Option Explicit
' Global variables
Dim strXMLResponse As String
' Call Examples
' getRiskCalcUS31()
' Debug.Print
getRiskCalcUS31(displayRequest:=true)
' Debug.Print
getRiskCalcUS31(displayRequest:=true, displayResponse:=true)
' Debug.Print getRiskCalcUS31()
Function getRiskCalcUS31( _
Optional usr As String _
, Optional pwd As String _
, Optional verbosity As Integer _
, Optional displayRequest As Boolean _
, Optional displayResponse As Boolean _
) As String
' Declare
Dim req As New MSXML2.XMLHttp
Dim reqData As String
Dim resData As String
' Parameter
safeguards/defaults
If IsMissing(usr) Or usr = "" Then usr =
"USER_NAME"
If IsMissing(pwd) Or pwd = "" Then pwd =
"PASSWORD"
If
IsMissing(displayRequest) Then displayRequest = False
If IsMissing(verbosity) Or verbosity = 0 Then verbosity = 8
' Request setup
reqData = _
"" & _
"" & _
"" & _
"" & usr & " "
& _
"" & pwd &
" " & _
"
" & _
""
reqData = reqData & _
"" & _
"" & _
"8 " & _
"00123456 " & _
"1 "
& _
"00000220|201304 "
& _
"2013 " & _
"4 " & _
"2012 " &
_
"12 " &
_
"Off "
& _
"FALSE "
reqData = reqData & _
"607646 "
& _
"1024152 "
& _
"156058 "
& _
"1474881 "
& _
"1423347 "
& _
"2063489 " & _
"1973636 "
& _
"179049 "
& _
"173073 "
& _
"31064 " & _
"17935 "
& _
"42691 " &
_
"41727 "
& _
"180246 "
& _
"178112 "
& _
"174989 " & _
"48668 "
& _
"144896 "
& _
"337302 "
& _
"
"SIC "
& _
"8062 "
& _
"
" & _
"
"
reqData = reqData & _
"
" & _
"
"
' Display the request?
If displayRequest = True Then
Debug.Print
"--------------------------------------------------------------------------------"
Debug.Print "REQUEST: "
Debug.Print reqData
Debug.Print
"--------------------------------------------------------------------------------"
End If
' Open
req.Open _
"POST" _
,
"https://batch-riskcalc.moodysrms.com/XMLBatch.asp" _
, False _
,
usr _
,
pwd
' Send
req.send reqData
' Display the response?
If displayResponse = True Then
Debug.Print
"--------------------------------------------------------------------------------"
Debug.Print "RESPONSE: " '& Chr(10)
Debug.Print req.responseText
Debug.Print
"--------------------------------------------------------------------------------"
End If
' Get 1yr EDF
Debug.Print
getEDF1yr(req.responseText)
' Return
strXMLResponse = req.responseText
getRiskCalcUS31 = req.responseText
End Function
' x. getRiskCalcOutputElement
'In Tools > References, add reference to
"Microsoft XML, vX.X" before running.
Public Function getRiskCalcOutputElement()
' Testing
Dim strXML As String
strXML
= getRiskCalcXMLOutputSample()
'strXML = strXMLResponse
' Get the section of the
XML that we need
Dim strXMLSection As String
Dim strXMLStartText As String: strXMLStartText =
"" '""
Dim strXMLEndText As String: strXMLEndText =
"
" '""
Dim strXMLStart As Integer: strXMLStart = InStr(1, strXML,
strXMLStartText, vbTextCompare)
strXMLSection = _
Mid( _
strXML _
, strXMLStart _
, InStr(strXMLStart, strXML, strXMLEndText, vbTextCompare) _
- strXMLStart _
+ Len(strXMLEndText) _
)
' XML Doc
Dim XDoc As New MSXML2.DOMDocument
XDoc.LoadXML (strXMLSection)
' Response
Dim rs As Object
Dim r As Object
' Each node
Dim n As MSXML2.IXMLDOMNode
For Each n In
XDoc.DocumentElement.ChildNodes
Set r.Type =
n.Attributes.getNamedItem("TYPE").Text
Set r.Value =
n.nodeTypedValue
rs.Add (r)
Debug.Print
n.Attributes.getNamedItem("TYPE").Text & ":" &
n.nodeTypedValue
Next n
' Clean
Set n = Nothing
Set XDoc = Nothing
' Return
getRiskCalcOutputElement = rs
End Sub
No comments:
Post a Comment