Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_Open()
    
    Call AddQuandl2Menu

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call DeleteQuandl2Menu
    
End Sub




Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "EditForm"
Attribute VB_Base = "0{509FC1EB-9BBE-4A0D-9AC8-25FDC064D05B}{1D12800B-A45E-4E31-99DB-CE06A907A46F}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CancelBut_Click()
    Unload Me
End Sub

Private Sub GoBut_Click()
    Call QEditDataset(txtCode.Text)
End Sub


Private Sub UserForm_Initialize()
    If Not (ActiveCell Is Nothing) Then
        txtCode.Text = ActiveCell.Value
        txtCode.SetFocus
        txtCode.SelStart = 0
        txtCode.SelLength = Len(txtCode.Text)
    End If
End Sub


Attribute VB_Name = "Edit"
Option Explicit

Const API_URL_EDIT = "https://www.quandl.com/api/v1/datasets/"
Const API_URL_EDIT_UPLOAD = "https://www.quandl.com/api/v2/datasets/"
Private auth_token As String

Public Sub QEditDataset(ByVal qcode As String)
    Call QuandlEdit(qcode)
End Sub

Private Function QuandlEdit(ByVal qcode As String) As Boolean
    auth_token = ThisWorkbook.Sheets("Config").Range("auth_token").Value
    
    If auth_token = "" Then
        MsgBox "No authentication token." _
            & vbCr & vbCr & "Please go to Preferences to enter it", vbCritical, appTitle
        
        Exit Function
    End If
    
    If qcode = "" Then
        MsgBox "Please enter dataset code", vbCritical, appTitle
        Exit Function
    End If
    
    If IsNumeric(qcode) Then
        MsgBox "For numeric codes please enter it in format <YOUR SOURCE CODE>/<CODE>", vbCritical, appTitle
        Exit Function
    End If
    
    
    ' Retrieve data first
    Dim dataArr() As Variant
    Dim dataset As New Collection
    Dim error As String
    
    Set dataset = QuandlRetrieveEdit(qcode, error)
    If error <> "" Then
        MsgBox error, vbCritical, appTitle
        GoTo exitfunction
    End If
    
    Unload EditForm
    
    'create new workbook
    Dim newbook As Variant
    Set newbook = Workbooks.Add
    newbook.Title = qcode
    newbook.Subject = qcode
    
    'ActiveWindow.Visible = False

    'insert in new workbook data
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("A4").Offset(0, 0).Resize(dataset.Count - 1, 1 + UBound(dataset(1))).Value2 = collectionToArray(dataset)
        

    Range(Range("A4").Offset(8, 0), Range("A4").Offset(8 + dataset.Count, 0)).NumberFormat = "yyyy-mm-dd"
    Range(Range("A4").Offset(8, 1), Range("A4").Offset(8 + dataset.Count, UBound(dataset(1)) - 1)).NumberFormat = "General"
        
    Range(Range("A4").Offset(7, 0), Range("A4").Offset(7 + dataset.Count, UBound(dataset(1)) - 1)).columns.AutoFit
    Range(Range("A4").Offset(7, 0), Range("A4").Offset(7, UBound(dataset(1)) - 1)).HorizontalAlignment = xlCenter
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(8, 0)).columns.AutoFit
    Range("A9").Value = "Help:"
    Range("B9").Value = "Edit code, name, description or privacy setting.  Add or remove any number of rows of data.  Edit any date or data point.  When finished, press ""Upload""."
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    'protect some cells from editing

    Range(Range("A4").Offset(1, 1), Range("A4").Offset(3, 1)).Locked = False 'metadata unlock to edit
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(3, 0)).Font.Color = RGB(116, 116, 116)
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(3, 0)).Interior.Color = RGB(234, 234, 234)
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(0, UBound(dataset(1)) - 1)).Font.Color = RGB(116, 116, 116)
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(0, UBound(dataset(1)) - 1)).Interior.Color = RGB(234, 234, 234)
    Range(Range("A4").Offset(4, 0), Range("A4").Offset(4, UBound(dataset(1)) - 1)).Font.Color = RGB(116, 116, 116)
    Range(Range("A4").Offset(4, 0), Range("A4").Offset(4, UBound(dataset(1)) - 1)).Interior.Color = RGB(234, 234, 234)
    Range(Range("A4").Offset(5, 0), Range("A4").Offset(5, UBound(dataset(1)) - 1)).Font.Color = RGB(116, 116, 116)
    Range(Range("A4").Offset(5, 0), Range("A4").Offset(5, UBound(dataset(1)) - 1)).Interior.Color = RGB(234, 234, 234)
    Range(Range("A4").Offset(5, 0), Range("A4").Offset(5, UBound(dataset(1)) - 1)).EntireRow.Font.Italic = True
    Range(Range("A4").Offset(0, 0), Range("A4").Offset(0, UBound(dataset(1)) - 1)).EntireRow.Font.Bold = True
    
    Range(Range("A4").Offset(7, 0), Range("A4").Offset(7 + 10000, UBound(dataset(1)) - 1)).EntireRow.Locked = False 'data unlock to edit
    Range(Range("A4").Offset(7, 0), Range("A4").Offset(7, UBound(dataset(1)) - 1)).EntireRow.Font.Bold = True
    
    'make link to dataset
    Call LinkToQuandlDataset(Range("B8").Value, Range("B8"))
    
    'merge description,name,code,link
    Range("B4:I4").Merge
    Range("B6:I6").Merge
    Range("B8:I8").Merge
    Range("B7:I7").Merge
    Range("B9:I9").Merge
    Range("B7").WrapText = True
    Range("B7").RowHeight = 30
    Range("A7:B7").VerticalAlignment = xlTop
    
    
    Range("B9").WrapText = True
    Range("B9").RowHeight = 45
    Range("A9:B9").VerticalAlignment = xlTop

    
    
     
    
    
    
    'add checkbox for private
    With ActiveSheet.CheckBoxes.Add(Range("B5").Left, Range("B5").Top, Range("B5").Width, Range("B5").Height)
    .Caption = ""
    If Range("B5").Value = "True" Then
        .Value = xlOn
    Else
        .Value = xlOff
    End If
    
    .name = ""
    End With
    Range("B5").Value = ""
    
    'upload button
    With ActiveSheet.Rectangles.Add(Range("A1").Left + 2, Range("A1").Top + 2, Range("A1:B1").Width - 4, Range("A1:A2").Height - 4)
    .OnAction = "QuandlUploadEdit"
    .Caption = "Upload"
    .Font.Size = 18
    .HorizontalAlignment = xlHAlignCenter
    .VerticalAlignment = xlVAlignCenter
    .name = "btnUpload"
    .Interior.Color = RGB(33, 115, 70)
    .Border.Color = RGB(33, 115, 70)
    .Font.Color = RGB(255, 255, 255)
    End With

    Range("A10").Activate
    ActiveSheet.Protect Contents:=True
    
    
    
    
exitfunction:
    ' return dataset
    QuandlEdit = True
    Workbooks(Workbooks.Count).Activate 'open just created workbook
    'Set req = Nothing
    Exit Function
ErrorHandler:
    'Set req = Nothing
    MsgBox "Unable to edit data. Please check your internet connection", vbCritical, appTitle

End Function


Private Function QuandlRetrieveEdit(ByVal qcode As String, ByRef error As String) As Collection

    ' Define data array, data set, and add headers

    Dim dataArr() As Variant
    Dim dataset As New Collection
    
    ' build the api url
    Dim editUrl As String
    
    qcode = UCase(Replace(Replace(qcode, "\", "."), ".", "/"))
    Dim tpos As Integer
    tpos = InStr(qcode, "/")
    If tpos > 0 Then
        editUrl = API_URL_EDIT & qcode
    Else
        editUrl = API_URL_EDIT & "myself/" & qcode
    End If
    'append version
    editUrl = editUrl & ".xml?" & CallIdentity() & "&auth_token=" & auth_token
    
    
    ' Get data from web
    Dim req As MSXML2.XMLHTTP60      ' changed from MSXML2.XMLHTTP for Excel 2013 64 bit support
    Set req = New MSXML2.XMLHTTP60   ' changed from MSXML2.XMLHTTP for Excel 2013 64 bit support

    On Error GoTo ErrorHandler
    Debug.Print editUrl
    req.Open "GET", editUrl, False
    req.send
    
    If req.Status = 403 Then
        error = "You are not authorized to edit this dataset."
        
        GoTo exitfunction
    End If
    
    If req.Status = 429 Then
        error = "You have exceeded the daily API limit. Please register at www.quandl.com and add your token in preferences."
        GoTo exitfunction
    End If
    
    If req.Status = 422 Or req.Status = 404 Then
        error = "You have specified an invalid Quandl Code"
        GoTo exitfunction
    End If
    
    If req.Status = 503 Then
        error = "Please try again"
        GoTo exitfunction
    End If
    
    Dim node As IXMLDOMNode
    Dim nodes As IXMLDOMNode
    Dim n As Integer

    ' Retrieve Column Headers
    Dim headers As New Collection
    Set nodes = req.responseXML.selectSingleNode("dataset / column-names")
    
    If nodes Is Nothing Then
        error = "Received invalid XML response"
        GoTo exitfunction
    End If

    For Each node In nodes.childNodes
        headers.Add (node.Text)
    Next node
    
    ' Define data array, data set, and add headers
    ReDim dataArr(1 To headers.Count)
    
    For n = 1 To headers.Count
            dataArr(n) = headers(n)
    Next n
    
    ' add all metadata
    Dim tempArr() As Variant
    ReDim tempArr(1 To headers.Count)
    dataset.Add (tempArr) ' collectionToArray ignored first row so a hack to add empty one
    tempArr(1) = "Code:"
    tempArr(2) = qcode
    dataset.Add (tempArr)
    tempArr(1) = "Private:"
    tempArr(2) = req.responseXML.selectSingleNode("dataset / private").Text
    dataset.Add (tempArr)
    tempArr(1) = "Name:"
    tempArr(2) = req.responseXML.selectSingleNode("dataset / name").Text
    dataset.Add (tempArr)
    tempArr(1) = "Description:"
    tempArr(2) = req.responseXML.selectSingleNode("dataset / description").Text
    dataset.Add (tempArr)
    tempArr(1) = "Link:"
    tempArr(2) = req.responseXML.selectSingleNode("dataset / source-code").Text & "/" & req.responseXML.selectSingleNode("dataset / code").Text
    dataset.Add (tempArr)
    
    tempArr(1) = ""
    tempArr(2) = ""
    dataset.Add (tempArr) ' break before data
    tempArr(1) = ""
    tempArr(2) = ""
    dataset.Add (tempArr) ' break before data
    dataset.Add (dataArr) ' columns
    
    
    
    ' Retrieve data set
    Set nodes = req.responseXML.selectSingleNode("dataset / data")
    
    For Each node In nodes.childNodes
        For n = 1 To headers.Count
            If node.childNodes(n - 1) Is Nothing Then
                dataArr(n) = ""
            Else
                dataArr(n) = node.childNodes(n - 1).Text
            End If
        Next n
        dataset.Add (dataArr)
    Next node
    
exitfunction:
    ' return dataset
    Set QuandlRetrieveEdit = dataset
    
    Set dataset = Nothing
    Set headers = Nothing
    Set node = Nothing
    Set nodes = Nothing
    Set req = Nothing
    Exit Function
ErrorHandler:
    Set dataset = Nothing
    Set headers = Nothing
    Set node = Nothing
    Set nodes = Nothing
    error = "Unable to retrieve data to edit. Raw response " & req.responseText
    Set req = Nothing
    

End Function

Private Function QuandlUploadEdit() As Boolean
    auth_token = ThisWorkbook.Sheets("Config").Range("auth_token").Value
' Define data array, data set, and add headers
    Dim dataArr() As Variant
    Dim dataset As New Collection
    
    ' build the api url
    Dim uploadUrl As String

    
    uploadUrl = API_URL_EDIT_UPLOAD
    
    Dim qcode As String
    qcode = UCase(Range("B4").Value)
    Dim tpos As Integer
    tpos = InStr(qcode, "/")
    If tpos = 0 Then qcode = "myself/" & qcode
    
    uploadUrl = uploadUrl & qcode & "/replace.json?"
    uploadUrl = uploadUrl & "auth_token=" & auth_token
        
    'append version
    uploadUrl = uploadUrl & "&" & CallIdentity()
    
    
    ' Find actual data to upload
    Dim data As String
    Dim column_names As String
    Dim c As Variant
    Dim r As Variant
    
    Dim post_data As String
    Dim qprivate As Boolean
    'If ActiveSheet.CheckBoxes.Value = "1" Then
    If ActiveSheet.CheckBoxes(1).Value = xlOn Then
        qprivate = True
    Else
        qprivate = False
    End If
    post_data = "name=" & URLEncode(Range("B6").Value) & "&private=" & LCase(qprivate) & "&description=" & URLEncode(Range("B7").Value)
    
    
    'add columns
    Dim num_columns As Integer, num_rows As Integer, max_columns As Integer, max_rows As Integer, col As String
    num_columns = 0
    Dim column_range As Range
    Set column_range = Range("A11").EntireRow
    max_columns = 1000

    col = column_range.Cells(1)
    Do While num_columns < max_columns And col <> ""
       column_names = column_names & "," & URLEncode(col)
       num_columns = num_columns + 1
       col = column_range.Cells(1 + num_columns).Value
    Loop
    column_names = Right(column_names, Len(column_names) - 1)
    post_data = post_data & "&column_names=" & column_names

    
    'add data
    max_columns = 1000
    max_rows = 10000
    num_rows = 0
    Dim data_range As Range
    Set data_range = Range(Range("A12").Offset(0, 0), Range("A12").Offset(max_rows, num_columns - 1))
    For Each r In data_range.rows
        Dim tempData As String
        tempData = ""
        For Each c In r.Cells
            tempData = tempData & "," & c.Value
        Next c
        If Len(tempData) = num_columns Then Exit For 'exit if empty row
        data = data & Right(tempData, Len(tempData) - 1) & "\n"
    Next r
    post_data = post_data & "&data=" & URLEncode(data)
    
    'Put data to the web
    Dim req As MSXML2.ServerXMLHTTP60
    Set req = New MSXML2.ServerXMLHTTP60
    On Error GoTo ErrorHandler
    
    req.Open "PUT", uploadUrl, False
    req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    req.setRequestHeader "Connection", "Keep-Alive"
    req.setRequestHeader "Accept-Language", "en"
    Call req.setRequestHeader("Content-Lenght", Len(post_data))
    req.send post_data
    req.getAllResponseHeaders
    
    
    Dim error As String
    Dim pos As Integer
    
    If req.Status = 200 Then
        ' notify user that it was updated!
        MsgBox "Dataset was updated successfully", vbInformation, appTitle
        GoTo exitfunction
    End If
    
    If req.Status = 429 Then
        MsgBox "You have exceeded the daily API limit. Please register at www.quandl.com and add your token in preferences.", vbCritical, appTitle
        
        GoTo exitfunction
    End If
    
    If req.Status = 403 Then
        MsgBox "You are not authorized to edit this dataset.", vbCritical, appTitle
        
        GoTo exitfunction
    End If
    
     If req.Status = 500 Then
        MsgBox "Format of the data is incorrect. Please go to www.quandl.com/help/excel for more info", vbCritical, appTitle
        GoTo exitfunction
    End If
    
    
    If req.Status = 422 Then
        'other errors
        pos = InStr(req.responseText, "errors")
        error = Right(req.responseText, Len(req.responseText) - pos + 1)
        pos = InStr(error, "}")
        error = Left(error, pos)
        Call MsgBox("Return code: " & req.Status & vbCrLf & error, vbCritical, appTitle)
        GoTo exitfunction
    End If
    
    If req.Status = 503 Then
        MsgBox "Your request was too large.", vbCritical, appTitle
        GoTo exitfunction
    End If
    
    ' If here we have problem for sure
    ' Retrieve Errors
    
    error = req.responseText
    MsgBox "Return code: " & req.Status & " " & vbCrLf & error, vbCritical, appTitle
       
    
exitfunction:
    QuandlUploadEdit = True
    
    Set req = Nothing
    Exit Function
ErrorHandler:
    MsgBox "Unable to upload data. Please check your data format" & vbCrLf & error, vbCritical, appTitle
    Set req = Nothing
    
    
End Function


Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "AdvancedForm"
Attribute VB_Base = "0{8770643A-4FA4-4741-BB8E-F9CB91B1071A}{95FAFBA1-BEED-453C-B5A7-89A8626A70FF}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

' AdvancedForm
Option Explicit

Private transformArr() As String
Private transformValuesArr() As String
Private datesArr() As String
Private datesValueArr() As String
Private collapseArr() As String





Private Sub SaveBut_Click()

End Sub

Private Sub UserForm_Initialize()
    ' Build the combo boxes
    Dim Ctr As Integer
    
    transformArr = Split(transformations, "|")
    transformValuesArr = Split(transformationsValues, "|")
    For Ctr = LBound(transformArr) To UBound(transformArr)
        Me.cmbTransform.AddItem transformArr(Ctr)
    Next
    Me.cmbTransform.ListIndex = defaultTransform
    
    datesArr = Split(dates, "|")
    datesValueArr = Split(datesValue, "|")
    For Ctr = LBound(datesArr) To UBound(datesArr)
        Me.cmbDates.AddItem datesArr(Ctr)
    Next
    Me.cmbDates.ListIndex = defaultDate
    
    collapseArr = Split(collapse, "|")
    For Ctr = LBound(collapseArr) To UBound(collapseArr)
        Me.cmbCollapse.AddItem collapseArr(Ctr)
    Next
    Me.cmbCollapse.ListIndex = defaultCollapse
End Sub

Private Sub GoBut_Click()
    'save old cursor
    Dim oldCursor As Variant
    oldCursor = Application.Cursor
    Application.Cursor = xlWait
    
    
    'save values
    defaultDate = Me.cmbDates.ListIndex
    defaultCollapse = Me.cmbCollapse.ListIndex
    defaultTransform = Me.cmbTransform.ListIndex
    
    Dim advanced As String
    Dim startDate As Date
    
    advanced = ""
    ' Deduce collapes
    If Me.cmbCollapse.ListIndex > 0 Then _
        advanced = advanced & "&collapse=" & collapseArr(Me.cmbCollapse.ListIndex)

    ' Deduce transformation
    If Me.cmbTransform.ListIndex > 0 Then _
        advanced = advanced & "&transformation=" & transformValuesArr(Me.cmbTransform.ListIndex)

    ' deduce start sdates
    If Me.cmbDates.ListIndex > 0 Then
        If Me.cmbDates.ListIndex <> 1 Then
            advanced = advanced & "&trim_start=" & Format(DateAdd("m", -1 * datesValueArr(Me.cmbDates.ListIndex), Date), "yyyy-mm-dd")
        Else
            advanced = advanced & "&rows=1"
        End If
    End If

    Unload Me
    ' Get data
    Call PrepareGetData(advanced)

    Application.Cursor = oldCursor


End Sub

Private Sub CancelBut_Click()
    
    Unload Me

End Sub


Attribute VB_Name = "HelpForm"
Attribute VB_Base = "0{ECAF158C-989D-478D-BCF7-5C27ABB11144}{EA50C03E-083B-49D0-982D-9409AC0C16EC}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
' AdvancedForm
Option Explicit


Private Sub Image1_Click()
    Dim link As String
    link = "https://www.quandl.com"
    On Error GoTo NoCanDo
    If Not ThisWorkbook Is Nothing Then
        ThisWorkbook.FollowHyperlink Address:=link, NewWindow:=True
        Unload Me
    Else
        MsgBox "Please open new or existing workbook first", vbExclamation, appTitle
    End If
    Exit Sub
NoCanDo:
    MsgBox "Cannot open " & link, vbExclamation, appTitle
    
End Sub


Private Sub Label5_Click()
    Dim link As String
    link = "https://www.quandl.com/help/excel"
    On Error GoTo NoCanDo

    Call OpenUrl(link)
    Unload Me

    Exit Sub
NoCanDo:
    MsgBox "Cannot open " & link, vbExclamation, appTitle
End Sub

Private Sub CloseBut_Click()
        
    Unload Me

End Sub

Private Sub Label6_Click()
    Dim link As String
    link = "mailto:excel@quandl.com"
    On Error GoTo NoCanDo

    Call OpenUrl(link)
    Unload Me

    Exit Sub
NoCanDo:
    MsgBox "Cannot open " & link, vbExclamation, appTitle
End Sub

Private Sub Label7_Click()

End Sub

Attribute VB_Name = "PreferencesForm"
Attribute VB_Base = "0{775E4745-2A43-40C4-A052-CBAB2847C158}{29110E2E-F6E6-4334-9BB9-F46B73AB572F}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
' AuthTokenForm
Option Explicit

Private Sub Label3_Click()

End Sub

Private Sub Label4_Click()
    Dim link As String
    link = "https://www.quandl.com/users/sign_up"
    On Error GoTo NoCanDo

    Call OpenUrl(link)
    Unload Me

    Exit Sub
NoCanDo:
    MsgBox "Cannot open " & link, vbExclamation, appTitle
End Sub

Private Sub TabStrip1_Change()

End Sub

Private Sub Label5_Click()
    Dim link As String
    link = "https://www.quandl.com/users/info"
    On Error GoTo NoCanDo
    
    Call OpenUrl(link)
    Unload Me
    
    Exit Sub
NoCanDo:
    MsgBox "Cannot open " & link, vbExclamation, appTitle
End Sub

Private Sub UserForm_Initialize()
    
    ' Initialise form from the Config sheet
    Me.tokenBox.Value = ThisWorkbook.Sheets("Config").Range("auth_token").Value
    If ThisWorkbook.Sheets("Config").Range("sort_order").Value = "sort_order_asc" Then
       Me.optSortOrderAsc.Value = True
    Else
       Me.optSortOrderDesc.Value = True
    End If
    
    If ThisWorkbook.Sheets("Config").Range("overwrite_confirm").Value = "overwrite_confirm_yes" Then
       Me.optOverwriteYes.Value = True
    Else
       Me.optOverwriteNo.Value = True
    End If
    

End Sub

Private Sub SaveBut_Click()

    Dim oldToken As String
    oldToken = ThisWorkbook.Sheets("Config").Range("auth_token").Value
    ThisWorkbook.Sheets("Config").Range("auth_token").Value = Me.tokenBox.Value
    
    If Me.optSortOrderDesc.Value = True Then
        ThisWorkbook.Sheets("Config").Range("sort_order").Value = "sort_order_desc"
    Else
        ThisWorkbook.Sheets("Config").Range("sort_order").Value = "sort_order_asc"
    End If

    If Me.optOverwriteYes.Value = True Then
        ThisWorkbook.Sheets("Config").Range("overwrite_confirm").Value = "overwrite_confirm_yes"
    Else
        ThisWorkbook.Sheets("Config").Range("overwrite_confirm").Value = "overwrite_confirm_no"
    End If


    If Me.tokenBox.Value <> oldToken Then
         ' Clear out previously saved favorites
        Dim favCol1 As Integer
        Dim favRow1 As Integer
        Dim favlastRow As Long
    
        With ThisWorkbook.Sheets("Config").Range("FavsName")
        
            favCol1 = .column
            favRow1 = .Row + 1
            favlastRow = LastRowInColumn(ThisWorkbook.Sheets("Config"), favCol1)
            
            If favlastRow >= favRow1 Then
                Range(.Offset(1, 0), .Offset(favlastRow - favRow1 + 1, 1)).ClearContents
            End If
        End With
        
    End If
    
    ' save addin with new token value
    ThisWorkbook.Save
    
    
    Call RefreshFavourites(Null, True)
    Unload Me

End Sub


Private Sub CancelBut_Click()
    
    Unload Me

End Sub


Attribute VB_Name = "Project"

' Subroutines and Functions

' Written by Sergei Ryshkevich, 2014 Q1
' sergei@quandl.com

Option Explicit

Public myRibbon As IRibbonUI

  
#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, Optional ByVal lpParameters As String, Optional ByVal lpDirectory As String, Optional ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, Optional ByVal lpParameters As String, Optional ByVal lpDirectory As String, Optional ByVal nShowCmd As Long) As Long
#End If

Sub Ribbon_OnLoad(ByVal ribbon As Office.IRibbonUI)

    Set myRibbon = ribbon
End Sub

Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String

  Dim StringLen As Long: StringLen = Len(StringVal)

  If StringLen > 0 Then
    ReDim result(StringLen) As String
    Dim i As Long, CharCode As Integer
    Dim Char As String, Space As String

    If SpaceAsPlus Then Space = "+" Else Space = "%20"

    For i = 1 To StringLen
      Char = Mid$(StringVal, i, 1)
      CharCode = Asc(Char)
      Select Case CharCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
        Case 32
          result(i) = Space
        Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
        Case Else
          result(i) = "%" & Hex(CharCode)
      End Select
    Next i
    URLEncode = Join(result, "")
  End If
End Function




Public Sub OpenUrl(ByVal link As String)

    Dim lSuccess As Long
    lSuccess = ShellExecute(0, "Open", link)

End Sub


Public Function MSOffVer() As Integer

' Function returns version of MS Office being run
'    9 = Office 2000
'   10 = Office XP / 2002
'   11 = Office 2003 & LibreOffice 3.5.2
'   12 = Office 2007
'   14 = Office 2010 / Office 2011 for Mac

' Written by Michael Chambers
    
    Dim verStr As String
    Dim startPos As Integer
    MSOffVer = 0
        
    verStr = Application.Version
    startPos = InStr(verStr, ".")
        
    On Error Resume Next
    If startPos > 0 Then
        MSOffVer = CInt(Left(verStr, startPos - 1))
    Else
        MSOffVer = CInt(verStr)
    End If
    On Error GoTo 0

End Function



Attribute VB_Name = "Download"

' Subroutines and Functions to download
' data from www.quandl.com

' Improved by Sergei Ryshkevich, 2014 Q1
' sergei@quandl.com


Option Explicit

Public defaultDate As Integer
Public defaultCollapse As Integer
Public defaultTransform As Integer

Global Const appTitle = "Quandl Data Add-in v2.0"
Global Const transformations = "original|change|% change|cumulative|normalize"
Global Const transformationsValues = "none|diff|rdiff|cumul|normalize"
Global Const dates = "all|1 day|3 months|1 year|2 years|5 years"
Global Const datesValue = "0|0.1|3|12|24|60"
Global Const collapse = "none|daily|weekly|monthly|quarterly|annual"

Const API_URL_DATA = "https://www.quandl.com/api/v1/multisets.xml?columns="  ' slash terminate
Const API_URL_DATA_datasets = "https://www.quandl.com/api/v1/datasets/"  ' slash terminate


Private auth_token As String

'Callback for QDataButton onAction
Sub GetDataQuandlButton(Optional control As IRibbonControl)

    Call PrepareGetData
 
End Sub

Public Sub PrepareGetData(Optional ByVal advanced As String = "")
    'gcheck if selection is valid
    If ActiveCell Is Nothing Then
        MsgBox "Please open workbook and enter dataset code", vbExclamation, appTitle
        GoTo exitfunction
    End If
    
   
    If Selection.rows.Count > 1 And Selection.columns.Count > 1 Then
        MsgBox "Multiple dataset codes can only be in single row\column", vbExclamation, appTitle
        GoTo exitfunction
    End If

    Dim qcode As String
    Dim c As Variant
    
    For Each c In Selection.Cells
        If c.Value <> "" Then qcode = qcode & UCase(c.Value) & ","
    Next
    
    If qcode = "" Then
        MsgBox "Please enter dataset code in the cell", vbExclamation, appTitle
        GoTo exitfunction
    End If
    
    qcode = Left(qcode, Len(qcode) - 1) 'remove last comma
    
    If Selection.rows.Count = 1 And Selection.columns.Count = 1 Then 'one code, use datasets API
        ' create dataset code
        Call GetDataDatasets(qcode, advanced)
    Else
        ' create multiset code which combines all datasets codes in all active cells
        Call GetData(qcode, advanced)
    End If
 
exitfunction:
End Sub


Public Sub LinkToQuandlDataset(ByVal datasetCode As String, ByRef cell As Range)
    With cell
        .Font.Underline = xlUnderlineStyleSingle
        .Font.Color = -4165632
    End With
    ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:="https://www.quandl.com/" & datasetCode, TextToDisplay:=UCase(datasetCode)
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True

End Sub

Public Sub GetData(ByVal qcode As String, Optional ByVal advanced As String = "")

    Dim oldCursor As Variant
    oldCursor = Application.Cursor
    Application.Cursor = xlWait
    
    ' Get data from web as an XML file
    Dim dataset As New Collection
    Dim error As String
    
    Set dataset = QuandlRetrieve(qcode, advanced, error)
    
    If error <> "" Then
        MsgBox error, vbCritical, appTitle
        GoTo ErrorHandler
…