Page Comparison

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

Here's how the Refresh button works:

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.
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.

Expand

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

Code Block

'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

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.
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.
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.
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:

Expand

title	See the code (click to expand)

Code Block

'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.

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

Expand

title	The following is the code for the

...

above methods (click to expand)

Code Block

'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

Versions Compared

Old Version 5

New Version Current

Key