Painting Blue Code: 02/01/2016

2016-02-27

Meteor - How to test and add CLIENT properties to Meteor.settings (settings.json startup config file)

Place this inside any of your templates, or add the main statements to an existing event.

Template.body.onRendered(function () {

    // Reading from settings.json
    console.log(
        Meteor.settings.public.EXISTING_PROPERTY_NAME
    );

    // Adding a variable/object
    Meteor.settings.public.NEW_PROPERTY_NAME = 'PROPERTY-CONTENT';
    console.log(
        Meteor.settings.public.NEW_PROPERTY_NAME
    );

});//rendered

Meteor - Settings.json split for privacy (client, server or both)

{
"public": {
        "PUBLIC-VAR-1": "Available to both CLIENT and SERVER."
        , "PUBLIC-VAR-2": "Public var 2 contents."
}

, "private": {
        "PRIVATE-VAR-1": "Available to only the SERVER ONLY (not to the client)."
        , "PRIVATE-VAR-2": "Private var 1 contents."
}
, "ROOT-LEVEL-VAR-1": "Available to the SERVER ONLY."
, "ROOT-LEVEL-VAR-2": "Root level var 2, only seen by the server."
}

Meteor - WebStorm Meteor Run settings to use settings.json

This is a screenshot of my environment configuration.

Pass "--settings settings.json" to the "Program argments" textbox of WebStorm's (a JavaScript IDE by JetBrains) run configuration.

Screen-shot:

2016-02-25

Meteor - How to access template parameters and its data context from within an event, programmatically

Template.TEMPLATE-NAME.events({

    "click .ELEMENT-CLASS" : function( evt, tmp ){
        console.log( tmp.data.PARAMETER-NAME );
        console.log( tmp.data.data.FIELD-NAME );

        // Output the template's entire data object so you can see what I mean...
        console.log(tmp.data);    }

});

2016-02-24

VBA - Get a string reversed

' 1. fun_String_Reverse
Public Function fStringReverse(InputString As String) As String

' Declare
Dim lLen As Long, lCtr As Long
Dim sChar As String
Dim sAns As String

' Process
lLen = Len(InputString)
For lCtr = lLen To 1 Step -1
sChar = Mid(InputString, lCtr, 1)
sAns = sAns & sChar
Next

' Return
fStringReverse = sAns

End Function

VBA - Get date/time in different formats (minutes, milliseconds)

Public Function getTimeInMS() As Long

Dim d As Date
d = Now()
Dim t As Single
t = Timer
getTimeInMS = _
( _
(Hour(d) * 10000000#) _
+ (Minute(d) * 100000#) _
+ (Second(d) * 1000#) _
+ fFloor((t - Int(t)) * 1000) _
)

End Function

' Get date in milliseconds
Public Function getDateInMS() As Double
Dim d As Date
d = Now()
Dim t As Single
t = Timer
getDateInMS = _
( _
( _
(Year(d) * 10000000000000#) _
+ (Month(d) * 100000000000#) _
+ (Day(d) * 1000000000#) _
+ (Hour(d) * 10000000#) _
+ (Minute(d) * 100000#) _
+ (Second(d) * 1000#) _
+ fFloor((t - Int(t)) * 1000) _
) _
)
End Function

' Get date in minutes
Public Function getDateInMin() As String
Dim d As Date
d = Now()
Dim t As Single
t = Timer
getDateInMin = _
( _
( _
(Year(d) * 100000000#) _
+ (Month(d) * 1000000#) _
+ (Day(d) * 10000#) _
+ (Hour(d) * 100#) _
+ (Minute(d) * 1#) _
) _
)
End Function

VBA - URL encoding function

Function getUrlEncode(strString) 'As String

' Declare
Dim strUrlEncode
Dim lngPos

' Each character
For lngPos = 1 To Len(strString)
getUrlEncode = _
strUrlEncode & "%" & _
Right( _
"0" & _
Hex(Asc(Mid(strString, lngPos, 1))) _
, 2 _
)
Next
getUrlEncode = strUrlEncode

End Function

EXCEL/VBA - Logged-in user/workstation info

'mWorkstationInfo
' Gets workstation information such as username, computername and domain
' Public functions listing
' 1 fWorkstationInfo_ComputerName()
' 2 fWorkstationInfo_UserName()
' 3 fWorkstationInfo_LogonDomain()
' 4 fWorkstationInfo_LanGroup()

Type WKSTA_INFO_101
wki101_platform_id As Long
wki101_computername As Long
wki101_langroup As Long
wki101_ver_major As Long
wki101_ver_minor As Long
wki101_lanroot As Long
End Type

Type WKSTA_USER_INFO_1
wkui1_username As Long
wkui1_logon_domain As Long
wkui1_logon_server As Long
wkui1_oth_domains As Long
End Type

Declare PtrSafe Function WNetGetUser& _
Lib "Mpr" Alias "WNetGetUserA" _
(lpName As Any, ByVal lpUserName$, lpnLength&)

Declare PtrSafe Function NetWkstaGetInfo& _
Lib "Netapi32" _
(strServer As Any, ByVal lLevel&, pbBuffer As Any)

Declare PtrSafe Function NetWkstaUserGetInfo& _
Lib "Netapi32" _
(reserved As Any, ByVal lLevel&, pbBuffer As Any)

Declare PtrSafe Sub lstrcpyW _
Lib "kernel32" _
(dest As Any, ByVal src As Any)

Declare PtrSafe Sub lstrcpy _
Lib "kernel32" _
(dest As Any, ByVal src As Any)

Declare PtrSafe Sub RtlMoveMemory _
Lib "kernel32" _
(dest As Any, src As Any, ByVal size&)

Declare PtrSafe Function NetApiBufferFree& _
Lib "Netapi32" _
(ByVal buffer&)

Public Function fWorkstationInfo(Optional strWhatInfoWanted As String) As String

'General declarations
Dim ret As Long, buffer(512) As Byte, i As Integer
Dim wk101 As WKSTA_INFO_101, pwk101 As Long
Dim wk1 As WKSTA_USER_INFO_1, pwk1 As Long
Dim cbusername As Long
Dim computerName As String, lanGroup As String, logonDomain As String, userName As String

'Initializations
computerName = "": lanGroup = "": userName = "": logonDomain = ""

'Call WNetGetUser to get the name of the user.
userName = Space(256)
cbusername = Len(userName)
ret = WNetGetUser(ByVal 0&, userName, cbusername)
If ret = 0 Then
userName = Left(userName, InStr(userName, Chr(0)) - 1) 'Success - strip off the null.
Else
userName = ""
End If

'================================================================
' The following section works only under Windows NT
'NT only - call NetWkstaGetInfo to get computer name and lan group
ret = NetWkstaGetInfo(ByVal 0&, 101, pwk101)
RtlMoveMemory wk101, ByVal pwk101, Len(wk101)
lstrcpyW buffer(0), wk101.wki101_computername
' Get every other byte from Unicode string.
i = 0
Do While buffer(i) <> 0
computerName = computerName & Chr(buffer(i))
i = i + 2
Loop
lstrcpyW buffer(0), wk101.wki101_langroup
i = 0
Do While buffer(i) <> 0
lanGroup = lanGroup & Chr(buffer(i))
i = i + 2
Loop
ret = NetApiBufferFree(pwk101)

' NT only - call NetWkstaUserGetInfo.
ret = NetWkstaUserGetInfo(ByVal 0&, 1, pwk1)
RtlMoveMemory wk1, ByVal pwk1, Len(wk1)
lstrcpyW buffer(0), wk1.wkui1_logon_domain
i = 0
Do While buffer(i) <> 0
logonDomain = logonDomain & Chr(buffer(i))
i = i + 2
Loop
ret = NetApiBufferFree(pwk1)
'End NT-specific section
'================================================================

'Return the desired value
Select Case strWhatInfoWanted
Case "lanGroup": fWorkstationInfo = lanGroup
Case "computerName": fWorkstationInfo = computerName
Case "userName": fWorkstationInfo = userName
Case "logonDomain": fWorkstationInfo = logonDomain
Case Else: fWorkstationInfo = userName & ";" & computerName & ";" & logonDomain & ";" & lanGroup
End Select
'Debug.Print computerName, lanGroup, userName, logonDomain

End Function

'Public functions
Public Function fWorkstationInfo_ComputerName()
fWorkstationInfo_ComputerName = fWorkstationInfo("computerName")
End Function

Public Function fWorkstationInfo_UserName()
' fWorkstationInfo_UserName = fWorkstationInfo("userName")
Dim s As String
s = fWorkstationInfo("userName")

' Salvador using the system within his network
If s = "Salvador.Delgadom" Then
s = "501963464"

' Carlos' 32-bit virtual machine
ElseIf s = "me" Then
s = "213061316"
End If

' Return
fWorkstationInfo_UserName = s
End Function

Public Function fWorkstationInfo_LogonDomain()
fWorkstationInfo_LogonDomain = fWorkstationInfo("logonDomain")
End Function

Public Function fWorkstationInfo_LanGroup()
fWorkstationInfo_LanGroup = fWorkstationInfo("lanGroup")
End Function

' LDB
Public Function getUserRoster() As String

' Declare, init
Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim i, j As Long
Dim result As String
result = ""
Dim str_Path As String
str_Path = CurrentProject.Path & "\" & CurrentProject.Name

cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.Open "Data Source=" & str_Path
cn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & str_Path

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets
Set RS = cn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Output the list of all users in the current database.
'Debug.Print _
rs.Fields(0).Name, "", _
rs.Fields(1).Name, "", _
rs.Fields(2).Name, _
rs.Fields(3).Name
While Not RS.EOF
'Debug.Print _
rs.Fields(0) _
, rs.Fields(1) _
, rs.Fields(2) _
, rs.Fields(3)
If InStr(1, result, Trim(RS.Fields(1)) & ";", vbTextCompare) = 0 Then
result = result & Trim(RS.Fields(1)) & ";"
End If
RS.MoveNext
Wend

' Discard objects
Set RS = Nothing
Set cn2 = Nothing
Set cn = Nothing

'Exit
getUserRoster = result

End Function

EXCEL/VBA - Copy programmatically given text to the clipboard

'Option Compare Database

'********* Code Start ************
' This code was originally written by Terry Kreft.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Terry Kreft
'
'Public Const GHND = &H42
Private Const GHND = &H42
'Public Const CF_TEXT = 1
Private Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Public Function ClipBoard_SetText(strCopyString As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)

' Unlock the memory and then copy to the clipboard
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
ClipBoard_SetText = CBool(CloseClipboard)
End If
End If
End Function

Public Function ClipBoard_GetText() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBText As String
Dim RetVal As Long
Dim lngSize As Long
If OpenClipboard(0&) <> 0 Then
' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If hClipMemory <> 0 Then
' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)
If lpClipMemory <> 0 Then
lngSize = GlobalSize(lpClipMemory)
strCBText = Space$(lngSize)
RetVal = lstrcpy(strCBText, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character.
strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
Call CloseClipboard
End If
ClipBoard_GetText = strCBText
End Function

Function CopyOlePiccy(Piccy As Object)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(Piccy) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

'Need to copy the object to the memory here

lpGlobalMemory = lstrcpy(lpGlobalMemory, Piccy)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If

' Clear the Clipboard.
X = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
'********* Code End ************

R - Monte Carlo simulation for Credit Risk (PD) Stress Testing Scenarios

################################################################################
# Stress Test Forecasting Model
# Monte Carlo Simulations
#
# Inputs:
# 1. Base portfolio, customers list with baseline probability of default.
# 2. Transition probability matrices, 1 per year, per scenario.
#
# Output:
# 1. Forecasted list of obligors defaulted per year/scenario... with an
# expected default frequency.
#
#
################################################################################

####
#### 1. Data import
####

# 1. Set default working path
setwd('S:/TMP Directory')

# 2. Import all obligors
# Columns required: Customer Id, Base Probability of Default
obl = read.csv('01 - Customers with PD.csv',header=T)

# 3. ORs
# We might move this out into an external file later on.
ORs = c(0.0001, 0.0003, 0.0004, 0.0005, 0.0006, 0.0007, 0.0008, 0.0012, 0.30, 1)

# 4. TPMs
# Use the same oTPM for the three years for base case.
# Use a different TPM for each year when calculating other scenarios such as Stress1 and Stress2.
oTPM1 = read.csv( '02.01 - TPM USA Stress 2 2010.csv', header = T )
oTPM2 = read.csv( '02.02 - TPM USA Stress 2 2011.csv', header = T )
oTPM3 = read.csv( '02.03 - TPM USA Stress 2 2012.csv', header = T )

####
#### 2. declarations and initializations
####

# 2.1. Define the Outupt Data Structure
output = data.frame( run=0, yr=0, rowid=0, customerId='a', basePD=0 )

# 2.2. Number of montecarlo simulations
numsims = 50

# 2.3. Number of years.
# Keep in mind that you will need to have loaded and to apply a different TPM
# for each of the years.
numyrs = 3

####
#### 3. Run the simulations
####
print( '3. Simulation...' )

# For each simulation
for( run in 1:numsims ){

# For each year
for( yr in 1:numyrs ){

# Apply the first TPM matrix to the first year
if ( yr == 1 ) {
strt = as.vector( obl$basePD )
tmp = strt
oTPM_local = oTPM1
} #yr1

# Apply the second TPM matrix to the second year
if( yr == 2 ) {
strt = tmp
oTPM_local = oTPM2
} #yr2

# Apply the third TPM to the third year
if( yr == 3 ) {
strt = tmp
oTPM_local = oTPM3
} #yr3

# Random number genarator draws
unif_draws = runif( length( tmp ) )
for( i in 1:length( ORs ) ){
breaks = oTPM_local[ oTPM_local$startPD == ORs[i] & oTPM_local$Prob != 0, 'LowerBound' ]
ORLevels = oTPM_local[ oTPM_local$startPD == ORs[i] & oTPM_local$Prob != 0, 'UpperBound' ]

#Just to be safe, let's sort them
breaks = breaks[ order( ORLevels ) ]
ORLevels = ORLevels[ order( ORLevels ) ]
tmp[ strt == ORs[i] ] = as.numeric( as.character( cut( x = unif_draws[strt == ORs[i]], c(breaks,1), ORLevels ) ) )
} #draw

# Only output if this transition to ORD (if it defaulted)
if( sum( strt != 1 & tmp == 1 ) > 0 ){
output = rbind( output, data.frame( run=run, yr=yr,
rowid=obl[strt!=1 & tmp==1,'rowid'],
customerId=obl[strt!=1 & tmp==1,'customerId'],
basePD=obl[strt!=1 & tmp==1,'basePD']) )
} #if defaulted

} #each year

} #each run/sim

####
#### 4. Output
####
print( '4. About to output... ' )
output = output[ 2 : nrow(output) , ]
table( output[ , c( 'run', 'yr' ) ] )
write.csv( output,'Defaulters.csv' )

EXCEL/VBA - Data connection query modification and refresh

strSQL = _

"select " & _

"'N/A' as UnionSource " & _

", 'ALL|' + Product + '|' + cast(OriginationYear as varchar(4)) as BusinessProductKey " & _

", 'ALL' as Business " & _

", Product " & _

strSQL = strSQL & _

"from " & _

"DATABASE.dbo.VIEW_OR_TABLE_NAME with(nolock) " & _

"where " & _

"1=1 " & _

"and Product is not null " & _

"and OriginationYear >= " & prmOriginationYearSince & " " & _

"group by " & _

"Product " & _

", OriginationYear " & _

"order by " & _

"1,2 " & _

";"

Debug.Print strSQL

With ActiveWorkbook.Connections("DATA_CONNECTION_NAME").ODBCConnection

.BackgroundQuery = False

.CommandText = strSQL

.RefreshOnFileOpen = False

.SavePassword = False

.SourceConnectionFile = ""

.SourceDataFile = ""

.ServerCredentialsMethod = xlCredentialsMethodIntegrated

.AlwaysUseConnectionFile = False

End With

ActiveWorkbook.Connections("DATA_CONNECTION_NAME ").Refresh

EXCEL/VBA - Calling Moody's RiskCalc WebService (example)

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