Extract EagleML via Excel - How the Refresh Works

In the new workbook, you can refresh the data by clicking the Refresh button.

Here's how the Refresh button works:

1. Clicking the Refresh button calls the Sub Extract_Data(feedType As String) method with the appropriate feed type.
   This method prepares extract parameters based on the specified feed type using the PrepareExtractParams(feedType) method, which retrieves data from the main worksheet’s Extract parameters section.

2. PrepareExtractParams(feedType) method generates a set of taskParameter nodes for the CM for extract and passes it along with the credentials and the server URL to the Sub Extract_TSR(url As String, Login As String, Pass As String, StrToEnv As String, feedType As String) method, which accepts the server URL, login, password, a set of taskParameter nodes, and the feed type of the object.

    The following is the code for the above methods (click to expand)

   'Prepares parameters for the extract using a feed type of the object type, being extracted
   Function PrepareExtractParams(feedType As String) As Object
   Dim ExtractParams As Object
   Dim SecAlias, FromDate, ToDate, FromEffectiveDate, ToEffectiveDate, Ticker, PrimaryAssetId, SourceName, OnlyHeld, HeldPositionSources, EntitySelectionType, EntitySelectionValue, EntityXrefType, MaxRows
   Set ExtractParams = CreateObject("scripting.dictionary")
   ExtractParams.Add "FeedType", feedType
   If StrComp(feedType, "SMFEXTRACT", vbTextCompare) = 0 Then
   SecAlias = Range("F15").Text
   FromDate = Range("F17").Text
   ToDate = Range("F19").Text
   OnlyHeld = Range("F21").Text
   HeldPositionSources = Range("F23").Text
   MaxRows = Range("F25").Text
   If SecAlias <> "" Then
   ExtractParams.Add "securityalias", SecAlias
   End If
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If StrComp(OnlyHeld, "yes", vbTextCompare) = 0 Then
   ExtractParams.Add "onlyheld", "Y"
   Else
   ExtractParams.Add "onlyheld", "N"
   End If
   If HeldPositionSources <> "" Then
   ExtractParams.Add "heldpositionsources", HeldPositionSources
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   If StrComp(feedType, "WRHSPOSITIONEXTRACT", vbTextCompare) = 0 Or StrComp(feedType, "WRHSTRADEEXTRACT", vbTextCompare) = 0 Then
   SecAlias = Range("F15").Text
   FromDate = Range("F17").Text
   ToDate = Range("F19").Text
   FromEffectiveDate = Range("F21").Text
   ToEffectiveDate = Range("F23").Text
   PrimaryAssetId = Range("F25").Text
   Ticker = Range("F27").Text
   SourceName = Range("F29").Text
   EntitySelectionType = Range("F31").Text
   EntitySelectionValue = Range("F33").Text
   EntityXrefType = Range("F35").Text
   MaxRows = Range("F37").Text
   If SecAlias <> "" Then
   ExtractParams.Add "securityalias", SecAlias
   End If
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If FromEffectiveDate <> "" Then
   ExtractParams.Add "FromEffectiveDate", Replace(FromEffectiveDate, ":", "-")
   End If
   If ToEffectiveDate <> "" Then
   ExtractParams.Add "ToEffectiveDate", Replace(ToEffectiveDate, ":", "-")
   End If
   If PrimaryAssetId <> "" Then
   ExtractParams.Add "primaryassetid", PrimaryAssetId
   End If
   If Ticker <> "" Then
   ExtractParams.Add "ticker", Ticker
   End If
   If SourceName <> "" Then
   ExtractParams.Add "sourcename", SourceName
   End If
   If EntitySelectionType <> "" Then
   ExtractParams.Add "entityselectiontype", EntitySelectionType
   ExtractParams.Add "entityselectionvalue", EntitySelectionValue
   End If
   If StrComp(EntitySelectionType, "EntityXrefId", vbTextCompare) = 0 And EntityXrefType <> "" Then
   ExtractParams.Add "EntityXrefType", EntityXrefType
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   If StrComp(feedType, "ENTITYEXTRACT", vbTextCompare) = 0 Then
   FromDate = Range("F15").Text
   ToDate = Range("F17").Text
   EntitySelectionType = Range("F19").Text
   EntitySelectionValue = Range("F21").Text
   EntityXrefType = Range("F23").Text
   MaxRows = Range("F25").Text
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If EntitySelectionType <> "" Then
   ExtractParams.Add "entityselectiontype", EntitySelectionType
   ExtractParams.Add "entityselectionvalue", EntitySelectionValue
   End If
   If StrComp(EntitySelectionType, "EntityXrefId", vbTextCompare) = 0 And EntityXrefType <> "" Then
   ExtractParams.Add "EntityXrefType", EntityXrefType
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   If StrComp(feedType, "REFTIMESERIESEXTRACT", vbTextCompare) = 0 Then
   FromDate = Range("F15").Text
   ToDate = Range("F17").Text
   MaxRows = Range("F19").Text
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   If StrComp(feedType, "SCHEDULEEXTRACT", vbTextCompare) = 0 Then
   SecAlias = Range("F15").Text
   FromDate = Range("F17").Text
   ToDate = Range("F19").Text
   FromEffectiveDate = Range("F21").Text
   ToEffectiveDate = Range("F23").Text
   PrimaryAssetId = Range("F25").Text
   Ticker = Range("F27").Text
   SourceName = Range("F29").Text
   OnlyHeld = Range("F31").Text
   HeldPositionSources = Range("F33").Text
   MaxRows = Range("F35").Text
   If SecAlias <> "" Then
   ExtractParams.Add "securityalias", SecAlias
   End If
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If FromEffectiveDate <> "" Then
   ExtractParams.Add "fromeffectivedate", FromEffectiveDate
   End If
   If ToEffectiveDate <> "" Then
   ExtractParams.Add "toeffectivedate", ToEffectiveDate
   End If
   If PrimaryAssetId <> "" Then
   ExtractParams.Add "primaryassetid", PrimaryAssetId
   End If
   If Ticker <> "" Then
   ExtractParams.Add "ticker", Ticker
   End If
   If SourceName <> "" Then
   ExtractParams.Add "sourcename", SourceName
   End If
   If StrComp(OnlyHeld, "yes", vbTextCompare) = 0 Then
   ExtractParams.Add "onlyheld", "Y"
   Else
   ExtractParams.Add "onlyheld", "N"
   End If
   If HeldPositionSources <> "" Then
   ExtractParams.Add "heldpositionsources", HeldPositionSources
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   If StrComp(feedType, "GENISSUEREXTRACT", vbTextCompare) = 0 Then
   FromDate = Range("F15").Text
   ToDate = Range("F17").Text
   MaxRows = Range("F19").Text
   If FromDate <> "" Then
   ExtractParams.Add "fromdate", Replace(FromDate, ":", "-")
   End If
   If ToDate <> "" Then
   ExtractParams.Add "todate", Replace(ToDate, ":", "-")
   End If
   If MaxRows <> "" Then
   ExtractParams.Add "maxrows", MaxRows
   End If
   Set PrepareExtractParams = ExtractParams
   End If
   End Function
   
   'Launches the extract process for a specified feed type
   Sub Extract_Data(feedType As String)
   Dim Login As String
   Dim Pass As String
   Dim ParamString As String
   Dim ParamName As String
   Dim ParamValue As String
   Dim i As Integer
   Dim Params As Object
   Set Params = PrepareExtractParams(feedType)
   
   Login = Range("F7").Text
   Pass = ActiveSheet.TextBox1.Text
   ParamString = ""
   
   'Wrap the extract parameters, generated by the PrepareExtractParams method into the <taskParameter> nodes
   For i = 0 To UBound(Params.Keys())
   ParamName = Params.Keys()(i)
   ParamValue = Replace(Params(ParamName), ":", "")
   ParamString = ParamString & "<taskParameter><name>" & ParamName & "</name><dataType>S</dataType><value>" & ParamValue & "</value></taskParameter>"
   Next
   
   'Start an extract using the wrapped parameters
   If Login <> "" And Pass <> "" Then
   Extract_TSR "https://eagleeccprod1.eagleaccess.com", Login, Pass, ParamString, feedType
   Else
   MsgBox "Invalid authorization!"
   End If
   
   End Sub

3. Extract_TSR method generates a SOAP request to the server and passes it to the Sub ExtractAndSave(data As String, url As String, Login As String, Pass As String, feedType As String) method.
4. Sub ExtractAndSave(data As String, url As String, Login As String, Pass As String, feedType As String)method, in turn, makes an HTTP request to the specified Web Service using the specified data and parses the response, passing it to the Sub ImportXMLtoList(PathToXML As String, feedType As String) method.
5. Sub ImportXMLtoList(PathToXML As String, feedType As String) method creates a new Extract result worksheet with the extract results being imported as a table, removes namespaces from all the column names, and removes columns that are not checked in the Profile section (second sheet) of the newly created workbook.

6. If the Extract result worksheet already exists, the Sub ImportXMLtoList(PathToXML As String, feedType As String) method clears out the existing worksheet data by using the following code:

    See the code (click to expand)

   'Create Extract result sheet if it does not exist and clear it, if it already exists
   Set resultSheet = WorkbookToWrite.Sheets("Extract result")
   If resultSheet Is Nothing Then
   Set resultSheet = WorkbookToWrite.Sheets.Add(After:=WorkbookToWrite.Sheets(WorkbookToWrite.Sheets.Count))
   resultSheet.Name = "Extract result"
   Else
   resultSheet.Cells.Clear
   End If

   and then imports the extract results.

7. Refresh process is finalized with the focus set on the Extract result worksheet.

    The following is the code for the above methods (click to expand)

   'Generates a SOAP request to the specified web-service using specified in the StrToEnv parameters, wrapped in the <taskParameter> nodes
   Sub Extract_TSR(url As String, Login As String, Pass As String, StrToEnv As String, feedType As String)
   Dim sEnv As String
   Dim sRTR As String
   
   sRTR = "<EagleML xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:type=""RunTaskRequest"" eaglemlVersion=""2-0"" actualBuild=""1"" xmlns=""http://www.eagleinvsys.com/2011/EagleML-2-0"">"
   sRTR = sRTR & "<header xmlns=""http://www.eagleinvsys.com/2011/EagleML-2-0"">"
   sRTR = sRTR & "<messageId>" & Format(Now(), "yyyymmddThhmmss") & "</messageId>"
   sRTR = sRTR & "<sentBy>user</sentBy>"
   sRTR = sRTR & "<sendTo>http://www.eagleinvsys.com/eagle_ml-2-0_default_cm_control_message</sendTo>"
   sRTR = sRTR & "</header>"
   sRTR = sRTR & "<taskIdentifier>"
   sRTR = sRTR & "<correlationId>" & Format(Now(), "yyyymmddThhmmss") & "</correlationId>"
   sRTR = sRTR & "<businessTaskId>" + feedType + "</businessTaskId>"
   sRTR = sRTR & "</taskIdentifier>"
   sRTR = sRTR & "<taskTypeEnum>NEW</taskTypeEnum>"
   sRTR = sRTR & "<synchronousExecution>yes</synchronousExecution>"
   sRTR = sRTR & "<taskParameters>"
   sRTR = sRTR & "<taskParameter>"
   sRTR = sRTR & "<name>ActionType</name>"
   sRTR = sRTR & "<dataType>S</dataType>"
   sRTR = sRTR & "<value>EXTRACT</value>"
   sRTR = sRTR & "</taskParameter>"
   sRTR = sRTR & "<taskParameter>"
   sRTR = sRTR & "<name>StreamName</name>"
   sRTR = sRTR & "<dataType>S</dataType>"
   sRTR = sRTR & "<value>eagle_ml-2-0_default_out_q</value>"
   sRTR = sRTR & "</taskParameter>"
   sRTR = sRTR & StrToEnv
   sRTR = sRTR & "</taskParameters>"
   sRTR = sRTR & "</EagleML>"
   
   sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"
   sEnv = sEnv & "<s:Envelope xmlns:s=""http://schemas.xmlsoap.org/soap/envelope/"">"
   sEnv = sEnv & " <s:Body xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"
   sEnv = sEnv & " <runTaskRequest xmlns=""http://www.eagleinvsys.com/2011/wsdl/EagleML-2-0"">"
   sEnv = sEnv & sRTR
   sEnv = sEnv & " </runTaskRequest>"
   sEnv = sEnv & " </s:Body>"
   sEnv = sEnv & "</s:Envelope>"
   
   'Make a request to the web-service and import the result
   ExtractAndSave sEnv, url, Login, Pass, feedType
   End Sub
   
   'Makes an http request to the specified web-service with specified credentials using a specified request message, parses the result and imports it to a 'Extract result' list of the currently active workbook
   Sub ExtractAndSave(data As String, url As String, Login As String, Pass As String, feedType As String)
   Dim StrXML As String
   Dim DirPathToXML As String
   Dim xmlHtp As Object
   Set xmlHtp = CreateObject("Microsoft.XmlHttp")
   Dim xDoc As Object
   Set xDoc = CreateObject("Microsoft.XMLDOM")
   DirPathToXML = CurDir() & "\extract_file.xml"
   
   'Make an HTTP POST reqeust to the web-service
   With xmlHtp
   .Open "POST", url & "/EagleMLWebService20", False, Login, Pass
   .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
   .setRequestHeader "Host", Replace(url, "http://", "")
   .setRequestHeader "Content-Encoding", "gzip, deflate"
   .setRequestHeader "soapAction", "/EagleMLWebService/RunTaskRequestSync"
   .send "" & data
   xDoc.LoadXML .responseText
   End With
   
   'Parse the result
   If xDoc.Text <> "" And InStr(xDoc.Text, "NO DATA") <= 0 And InStr(xDoc.Text, "NO_DATA") <= 0 Then
   
   If InStr(xDoc.Text, "ERROR") > 0 Or InStr(xDoc.Text, "Failed") > 0 Then
   MsgBox Replace(xDoc.Text, Left(xDoc.Text, InStr(xDoc.Text, "ERROR1") + 5), ""), vbCritical, "Error extrat"
   Else
   StrXML = Replace(xDoc.Text, Left(xDoc.Text, InStr(xDoc.Text, "<EagleML") - 1), "")
   StrXML = Left(StrXML, InStr(StrXML, "</EagleML>") - 1)
   If StrComp(feedType, "WRHSPOSITIONEXTRACT", vbTextCompare) = 0 Or StrComp(feedType, "WRHSTRADEEXTRACT", vbTextCompare) = 0 Then
   StrXML = StrXML & "<warehouseTransaction></warehouseTransaction></EagleML>"
   End If
   If StrComp(feedType, "ENTITYEXTRACT", vbTextCompare) = 0 Then
   StrXML = StrXML & "<entityTransaction></entityTransaction></EagleML>"
   End If
   If StrComp(feedType, "REFTIMESERIESEXTRACT", vbTextCompare) = 0 Or StrComp(feedType, "SCHEDULEEXTRACT", vbTextCompare) = 0 Or StrComp(feedType, "GENISSUEREXTRACT", vbTextCompare) = 0 Or StrComp(feedType, "SMFEXTRACT", vbTextCompare) = 0 Then
   StrXML = StrXML & "<referenceTransaction></referenceTransaction></EagleML>"
   End If
   
   Shell "cmd.exe /c cd. > " & DirPathToXML
   
   Open DirPathToXML For Output As #1
   Print #1, StrXML
   Reset
   
   'Import the extract result to the 'Extract result' sheet
   ImportXMLtoList DirPathToXML, feedType
   End If
   Else
   MsgBox "NO DATA"
   End If
   Set xmlHtp = Nothing
   Set xDoc = Nothing
   End Sub
   
   'Imports the xml from the path, specified in the PathToXML variable to the 'Extract result' sheet of the last created workbook
   Sub ImportXMLtoList(PathToXML As String, feedType As String)
   Dim wb As Workbook
   Dim WorkbookToWrite As Workbook
   Set WorkbookToWrite = Workbooks(Workbooks.Count)
   
   'Prevent screen updates and alerts
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   'Import XML as table
   Set wb = Workbooks.OpenXML(Filename:=PathToXML, LoadOption:=xlXmlLoadImportToList)
   Application.DisplayAlerts = True
   Dim resultSheet As Object
   On Error Resume Next
   
   'Create Extract result sheet if it does not exist and clear it, if it already exists
   Set resultSheet = WorkbookToWrite.Sheets("Extract result")
   If resultSheet Is Nothing Then
   Set resultSheet = WorkbookToWrite.Sheets.Add(After:=WorkbookToWrite.Sheets(WorkbookToWrite.Sheets.Count))
   resultSheet.Name = "Extract result"
   Else
   resultSheet.Cells.Clear
   End If
   wb.Sheets(1).UsedRange.Copy resultSheet.Range("A1")
   wb.Close False
   resultSheet.Activate
   
   'Fix for the extracts, containing exaclty one row being displayed without headers in the table, when imported from XML
   With ActiveSheet.UsedRange
   ActiveSheet.Rows(.Rows.Count).Delete
   End With
   
   Application.ScreenUpdating = True
   
   'Remove the namespaces from the column headers from Extract result and then remove the columns, which are not checked in the corresponing Profile list
   Dim lastColumn As Long
   lastColumn = resultSheet.Cells(1, Columns.Count).End(xlToLeft).Column
   Dim i As Integer
   Dim j As Integer
   Dim profileSheet As Object
   Set profileSheet = WorkbookToWrite.Sheets(2)
   Dim lastFilterRow As Long
   lastFilterRow = profileSheet.Cells(Rows.Count, 2).End(xlUp).Row
   Dim chosenFileNames As Object
   Set chosenFileNames = CreateObject("scripting.dictionary")
   For i = 1 To lastFilterRow - 2
   If profileSheet.CheckBoxes("filterCheckBox" & i).Value = xlOn Then
   chosenFileNames.Add profileSheet.Cells(i + 2, 2).Value, i
   End If
   Next i
   For i = 1 To lastColumn
   Dim curName As String
   Dim firstColon As Integer
   curName = resultSheet.Cells(1, i).Value
   firstColon = 0
   For j = 1 To Len(curName)
   If StrComp(Mid(curName, j, 1), ":", vbTextCompare) = 0 Then
   firstColon = j
   Exit For
   End If
   Next j
   curName = Right(curName, Len(curName) - firstColon)
   resultSheet.Cells(1, i).Value = curName
   Next i
   For i = 1 To lastColumn
   curName = resultSheet.Cells(1, i).Value
   If StrComp(curName, "", vbTextCompare) = 0 Then
   Exit For
   End If
   Dim lastNum As Integer
   lastNum = 0
   For j = Len(curName) To 1 Step -1
   If IsNumeric(Mid(curName, j, 1)) Then
   lastNum = j
   Else
   Exit For
   End If
   Next j
   curName = Left(curName, lastNum - 1)
   If Not chosenFileNames.Exists(curName) Then
   resultSheet.Columns(i).EntireColumn.Delete
   i = i - 1
   End If
   Next i
   End Sub