Friday 15 June 2012

Model View Controller (MVC) implementation in Excel VBA

With this post I would like to illustrate the concept of Model View Controller (MVC) design pattern implemented in excel VBA with a simple and easy to understand example.

The model view controller design pattern has a benefit which provides separation of concern objectively while designing the solution. With this technique in hand, the data is modelled as an object and the form in which is represented is also modelled as object with relevant functions provided for the operations required, which is orchestrated by a controller class.


 

The attached example is a crude implementation of MVC a quick attempt of mine to achieve the same, though I do accept that this piece of code is far from perfection and has still room to improve upon.

Explanation:

The workbook has simple worksheet which on one side has form to display the data (left) and on (right) a table storing multiple values for the same. The workbook has two functionalities provided to get the relevant data based on the serial number provided and update functionality to update the corresponding the record.


 

Please check the workbook VBA code for MVC implementation details.

Download:

Download Solution
Download solution



Refrences:
Link: http://en.wikipedia.org/wiki/Model%E2%80%93view%E2%80%93controller

Unlimited Function Arguments – ParamArray in VBA

Recently I stumbled upon an interesting functionality provided by VBA, termed by ‘ParamArray’ keyword.

This key word is used in to send unknown number of arguments in the form of variant array to the function/sub-procedure in VBA.

This can be illustrated via following code:

Option Explicit

'The following VBA illustrates the use of ParamArray functionality illustrated by a
'functiuon returning the count of arguments passed to the function.

Function param_array_function(ParamArray Args() As Variant) As Integer

    Dim iCount As Integer
    iCount = UBound(Args)
    param_array_function = IIf(iCount < 0, 0, iCount + 1)

End Function


Sub Test_Proc()

Debug.Print "Args :" & param_array_function(1, 2, 3, 4, 5)
Debug.Print "Args :" & param_array_function("amol", "pandey", "excel", "vba")
Debug.Print "Args :" & param_array_function(1, 2, 3)
Debug.Print "Args :" & param_array_function(1, 2)

End Sub


This functionality can be very handy to design function/sub-procedures which are generic enough to take in multiple arguments previously unknown and provides an alternative to send in arguments previously being packed in array/collection for the same purposes.

Refrences:
Link: http://www.cpearson.com/excel/optionalargumentstoprocedures.aspx

Time Slide Chart In Excel

Recently out of curiosity, I wanted to explore a time series data relationship with itself visually on a varying time scale. Hence, I wanted a time series plotted twice on the same chart, but one being flexible (sliding) to slide upon another (fixed).

These are the series of the following charts, I wanted to build in which it is clear that the Value (Blue) is fixed upon which the sliding series is the Slide Value (Grey):


 


 


 


 



The attached spreadsheet illustrates the complete mechanism of building the same, it uses couple of excel formulas and a form control slider. The slider in the workbook allows the flexibility to slide the time series in both forward and backward equally to the original count of the series points available. Additionally in spreadsheet there are no macros, all the functionality is built via default excel provided formulas and also had to use couple of na() formulas for chart to appear as required.

This technique can also be used to analyse additional statistics based upon sliding series. E.g. Max, Min, Average, Standard Deviation and more…

Feel free to contact me for more info upon its design.

Download:

Download Solution
Download solution

Sunday 20 May 2012

Key Word Web Parser Tool (Selenium Vs WinHttp)

With this post I wanted to highlight two interesting techniques for web text parsing via VBA using Selenium framework and WinHttp.

Task:

Given the set of key words (comma separated list) we want to count the occurrence of the key word in the html body of the web page (giving us the popularity of the key word within the set of web pages).

Solution One:

Selenium” as popularly known in the market, is a very robust web testing framework and used in writing automated testing for Web UI. So recently I stumbled upon a very interesting project which is a wrapper written for using selenium via VBA exposing very strong integration of selenium functionalities with VBA. The project home page is very good in describing upon the features of the same.

 

Solution Two:

Using the native WinHttp solution in VBA, we are downloading the HTML text of the web page via “GET” command and thus counting the key word occurrence in the same.

 

Comparison:

For the task in hand I found that using the WinHttp solution wins over the Selenium based methodology purely by the performance and over head the Selenium incurs for the same.

The Selenium framework has its own very important place to automate the Web UI task in hand when JavaScript is also in play with modern day web pages. Selenium plays a very important role where one can script all the user actions that have to be performed on the web, like filling forms, clicking buttons, checking options and more with the power of VBA.

Note: There is a large difference in count values between the Selenium and WinHttp based tools, for the reason that for former I am using Instr function to get the key word count, where as for the later I a using custom written function for the key word count.

Download Solution
Download solution


References:
Link1: http://code.google.com/p/selenium-vba/

Friday 4 May 2012

Excel VBA Data Warehouse Generator Tool

Recently I was observing our database development team, and I observed that much of my colleagues were struggling with lots of boiler plate code. In the process of generating Dimension and Fact tables (in snow flaked schema), I thought it would be nice to create an easy to use tool to generate database schema with the following rules in place:

1. Each dimension table would have a primary key, combined with identity auto generation.
2. A dimension table may have referential constraint upon another dimension table
3. A fact table will have multiple referential constraints from multiple dimension tables but not from any other factual table.
4. A fact table will not have a primary key nor an identity column.

This tool is primarily an assisting tool for repetitive process occurred in the data warehouse table structure generation, though for any other design requirements developer intervention is very much required to meet the special conditions.



To use the tool, there is a main page where all the relevant information needs to be set like connection string, script folder path and updated database on which the operation needs to be performed once the list is refreshed.

Control Page:


Dimension Page:


Fact Page:


Then there is a SQL Server Management Studio style dimension and fact table generation worksheets where user can set the desired columns required according to the business needs along with integrated drop down list on the Table Link column where the refrence dimension tables can be selected(The table name for dimension and fact wil be appended by keywords "Dim" and "Fact" respectivly. And also for the dimension tables the key columns as they will be auto generated via VBA and appended terms like "Id").

Download Solution
Download solution

File - Directory (Tree Map) in Excel

Being a software developer and in my quest of achieving an organised methodology for saving my personal files, I many times end up saving same file in multiple locations. Ahh…

So many times we can’t keep track of how our file structure if expanding underlying the cover of multiple nested folders. So, I thought to develop a tool in Excel/VBA which could visually represent me the file directory structure in the form of tree and also could provide me an easy to navigate mechanism for the nodes I wish to explore.

Some thing like this …



This tool request for the root node location to start its parsing and with the condition provided by the user to layout the sub folder (recursively) by a check box you will achieve the above result.

Public Sub FileLister(rootPath As String, exploreSubFolder As Boolean)

    Dim file As Scripting.file, folder As Scripting.folder, subfolder As Scripting.folder

    If fso Is Nothing Then
        Set fso = New FileSystemObject
    End If

    Set folder = fso.GetFolder(rootPath)

    If (folder.SubFolders.Count > 0) And exploreSubFolder Then
    
        For Each subfolder In folder.SubFolders
            
            nestLevel = nestLevel + 1
            ReDim Preserve navigated(nestLevel)
            
            If navigated(nestLevel) = 0 Then
                For Each file In folder.Files
                    'Record files in folder
                    anchorRange.Offset(printRow, nestLevel + 1).Value = file.Name
                    anchorRange.Offset(printRow, 0).Hyperlinks.Add Control.Range("A12").Offset(printRow, 0), file.path, , , "Link"
                    printRow = printRow + 1
                Next file
            End If
            
            anchorRange.Offset(printRow, nestLevel + 1).Value = subfolder.Name
            anchorRange.Offset(printRow, nestLevel + 1).Interior.Color = 10092543  'Light Yellow
            anchorRange.Offset(printRow, 0).Hyperlinks.Add Control.Range("A12").Offset(printRow, 0), subfolder.path, , , "Link"
            printRow = printRow + 1

            navigated(nestLevel) = 1
            FileLister subfolder.path, exploreSubFolder
            nestLevel = nestLevel - 1
            
        Next subfolder
        
    Else
    
        nestLevel = nestLevel + 1
        For Each file In folder.Files
            'Record files in folder
            anchorRange.Offset(printRow, nestLevel + 1).Value = file.Name
            anchorRange.Offset(printRow, 0).Hyperlinks.Add Control.Range("A12").Offset(printRow, 0), file.path, , , "Link"
            printRow = printRow + 1
        Next file
        For Each subfolder In folder.SubFolders
            anchorRange.Offset(printRow, nestLevel + 1).Value = subfolder.Name
            anchorRange.Offset(printRow, nestLevel + 1).Interior.Color = 10092543  'Light Yellow
            anchorRange.Offset(printRow, 0).Hyperlinks.Add Control.Range("A12").Offset(printRow, 0), subfolder.path, , , "Link"
            printRow = printRow + 1
        Next subfolder
        nestLevel = nestLevel - 1
        
        If exploreSubFolder Then
            navigated(nestLevel) = 0
        End If
        
    End If
End Sub


Download:

Download Solution
Download solution


Friday 20 April 2012

Analytics on Analytics Hmm..?? (Google Analytics to Excel)

Recently I came across a project requirement which interested me quite a lot; the project actually did analytics on top of Google analytics data (though Google Analytics does indeed provide a lot of interesting analytics, via its feature rich platform). Interestingly I don’t understand where the human quest for analytics will end, but it keeps me on my toes to build some exciting tools.

So the challenge presented to me was to download the Google analytics data to excel on demand by the user. This presented me with the following technical challenges:

1. User Authentication for access to Google API
2. Google analytics API mechanism for data download



Thus the major key to the excel model is in the authentication subroutine which retrieves the authentication key for the future request authentication based on user credentials as follows:

Private Function getGAauthenticationToken(ByVal email As String, ByVal password As String)
    Dim authResponse As String
    Dim authTokenStart As Integer
    Dim URL As String
    Dim authtoken As String

    If email = "" Then
        getGAauthenticationToken = ""
        Exit Function
    End If

    If password = "" Then
        getGAauthenticationToken = "Input password"
        Exit Function
    End If
    password = modCommonFunctions.uriEncode(password)

    On Error GoTo errhandler
    Dim objhttp As Object
    Set objhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    URL = "https://www.google.com/accounts/ClientLogin"
    objhttp.Open "POST", URL, False
    objhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    objhttp.setTimeouts 1000000, 1000000, 1000000, 1000000
    objhttp.send ("accountType=GOOGLE&Email=" & email & "&Passwd=" & password & "&service=analytics&Source=Excel based analytics. (c) Amol Pandey 2012")
    authResponse = objhttp.responseText
    If InStr(1, authResponse, "BadAuthentication") = 0 Then
        authTokenStart = InStr(1, authResponse, "Auth=") + 4
        authtoken = Right(authResponse, Len(authResponse) - authTokenStart)
        getGAauthenticationToken = authtoken
    Else
        getGAauthenticationToken = "Authentication failed"
    End If
    Exit Function
errhandler:
    getGAauthenticationToken = "Authentication failed"
End Function

Rest of the request are appended by the authentication id obtained from the previous module for request authentication for the data download from API, leaving us with the XML formatted data to lay out as desired on to excel worksheet.
Private Sub getDetailedGoogleAnalyticsData(authtoken As String, profileNumber As Long, startDate As Date, endDate As Date, metrics() As String, Optional dimensions As Variant)

    Dim httpUrl As String
    Dim request As MSXML2.ServerXMLHTTP60
    Dim requstTimeOut As Long
    Dim requestReponseText As String
    Dim startDateString As String, endDateString As String
    Dim item As Variant, subItem As Variant, responseXml As MSXML2.DOMDocument
    Dim rowCount As Integer
    'clear Range
    RawData.Range("F5:F6").ClearContents
    RawData.Range("H2").Resize(MAX_ROWS, 4).ClearContents
    rowCount = 0

    startDateString = Year(startDate) & "-" & Right("0" & Month(startDate), 2) & "-" & Right("0" & Day(startDate), 2)
    endDateString = Year(endDate) & "-" & Right("0" & Month(endDate), 2) & "-" & Right("0" & Day(endDate), 2)

    httpUrl = "https://www.google.com/analytics/feeds/data?ids=ga:" & profileNumber & "&start-date=" & startDateString & "&end-date=" & endDateString & "&max-results=10000&metrics="

    For Each item In metrics
        httpUrl = httpUrl & "ga:" & item & ","
    Next item
    httpUrl = Left(httpUrl, Len(httpUrl) - 1)


    'Aggreagted values
    Set request = New MSXML2.ServerXMLHTTP60
    requstTimeOut = 1000000
    request.Open "GET", httpUrl, False
    request.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    request.setRequestHeader "Authorization", "GoogleLogin Auth=" & authtoken
    request.setRequestHeader "GData-Version", "2"
    request.setTimeouts requstTimeOut, requstTimeOut, requstTimeOut, requstTimeOut
    request.send ("")
    Set responseXml = request.responseXml
    For Each item In responseXml.ChildNodes(1).ChildNodes
        If item.nodeName = "dxp:aggregates" Then
            For Each subItem In item.ChildNodes
                If subItem.Attributes.Length > 0 Then
                    RawData.Range("F5").Offset(rowCount, 0).Value = subItem.Attributes(3).Value
                    rowCount = rowCount + 1
                End If
            Next subItem
        End If
    Next item
    If Not (IsError(dimensions)) Then
        httpUrl = httpUrl + "&dimensions="
        For Each item In dimensions
            httpUrl = httpUrl & "ga:" & item & ","
        Next item
        httpUrl = Left(httpUrl, Len(httpUrl) - 1)
        Set request = New MSXML2.ServerXMLHTTP60
        requstTimeOut = 1000000
        request.Open "GET", httpUrl, False
        request.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        request.setRequestHeader "Authorization", "GoogleLogin Auth=" & authtoken
        request.setRequestHeader "GData-Version", "2"
        request.setTimeouts requstTimeOut, requstTimeOut, requstTimeOut, requstTimeOut
        request.send ("")
        Set responseXml = request.responseXml
        rowCount = 0
        For Each item In responseXml.ChildNodes(1).ChildNodes
            If item.nodeName = "entry" Then
                RawData.Range("H2").Offset(rowCount, 0).Value = item.ChildNodes(4).Attributes(1).Value    'Country
                RawData.Range("H2").Offset(rowCount, 1).Value = item.ChildNodes(5).Attributes(1).Value    'region
                RawData.Range("H2").Offset(rowCount, 2).Value = item.ChildNodes(6).Attributes(3).Value    'visits
                RawData.Range("H2").Offset(rowCount, 3).Value = item.ChildNodes(7).Attributes(3).Value    'pageviews
                rowCount = rowCount + 1
            End If
        Next item
    End If
End Sub

The attached excel model takes in the user details, then fetches the list of web sites monitored by the user account, and then on second step downloads the country wise detailed data of page visit and views for the selected site via drop down.

Happy analytics…

Download:

Download Solution
Download solution


Refrences:
Link1: http://www.automateanalytics.com/2009/08/excel-functions-for-fetching-data.html
Link2: https://developers.google.com/analytics/
Link3: https://developers.google.com/analytics/devguides/reporting/core/dimsmets

Tuesday 17 April 2012

Indian Market Data Download (NSE & BSE)

Recently while browsing the Indian stock market web sites (NSE and BSE), a thought came by to build a automated data downloader for the historical equity prices to be analyzed in excel.

Henceforth the following tool was built to do the same. This tool extracts the data from the exchanges (NSE and BSE) website (Historical Data Section) for the equity and the time period requested (Currently the tool downloads the daily data only but easily configurable via code to monthly/yearly).

The data downloaded via tool is placed on separate sheets for both NSE and BSE, upon which any post download analysis can be conducted..

Hope this tool helps you in outperform the markets better. Happy trading..

 


modNse.bas
Option Explicit

Private Const NSE_URL As String = "http://www.nseindia.com/products/dynaContent/common/productsSymbolMapping.jsp?symbol={0}&segmentLink=3&symbolCount=1&series=EQ&dateRange=+&fromDate={1}&toDate={2}&dataType=PRICEVOLUME"

Public Sub GetNseData()

    Dim request As WinHttp.WinHttpRequest
    Dim htmlDocument As MSHTML.htmlDocument
    Dim rowCollection As Variant
    Dim htmlRow As Variant
    Dim rowSubContent As Variant
    Dim rowSubData As Variant
    Dim rowCount As Integer, colCount As Integer
    Dim anchorRange As Range
    Dim prepUrl As String
    Dim timeOut As Long

    On Error GoTo errHandler
    
    timeOut = 10000
    DataDumpNse.Cells.Clear
    Set anchorRange = DataDumpNse.Range("A1")

    Set htmlDocument = New MSHTML.htmlDocument

    Set request = New WinHttp.WinHttpRequest

    prepUrl = Replace(NSE_URL, "{0}", modCommonFunctions.URLEncode(ThisWorkbook.Names("NSE_TICKER").RefersToRange.Value))
    prepUrl = Replace(prepUrl, "{1}", Format(ThisWorkbook.Names("NSE_FROM_DATE").RefersToRange.Value, "dd-mm-yyyy"))
    prepUrl = Replace(prepUrl, "{2}", Format(ThisWorkbook.Names("NSE_TO_DATE").RefersToRange.Value, "dd-mm-yyyy"))
    request.Open "GET", prepUrl
    request.SetTimeouts timeOut, timeOut, timeOut, timeOut
    request.Send
    htmlDocument.body.innerHTML = request.ResponseText

    rowCount = 0
    colCount = 0

    Set rowCollection = htmlDocument.getElementsByTagName("tr")
    For Each htmlRow In rowCollection
        Set rowSubContent = htmlRow.getElementsByTagName("th")
        If rowSubContent.Length <> 0 Then
            For Each rowSubData In rowSubContent
                anchorRange.Offset(rowCount, colCount).Value = rowSubData.innerText
                colCount = colCount + 1
            Next rowSubData
        Else
            Set rowSubContent = htmlRow.getElementsByTagName("td")
            For Each rowSubData In rowSubContent
                anchorRange.Offset(rowCount, colCount).Value = rowSubData.innerText
                colCount = colCount + 1
            Next rowSubData
        End If

        colCount = 0
        rowCount = rowCount + 1
    Next htmlRow
    
    Exit Sub
    
errHandler:
    MsgBox Err.Description, vbExclamation, "Download Error"
    On Error GoTo 0
    Err.Clear
End Sub



modBse.bas
Option Explicit

Private Const BSE_URL As String = "http://www.bseindia.com/stockinfo/stockprc2_excel.aspx?scripcd={0}&FromDate={1}&ToDate={2}&OldDMY=D"

Public Sub GetBseData()

    Dim request As WinHttp.WinHttpRequest
    Dim lineSplit As Variant
    Dim rowCount As Long
    Dim line As Variant
    Dim anchorRange As Range
    Dim url As String
    
    DataDumpBse.Cells.Clear
    Set anchorRange = DataDumpBse.Range("A1")
    
    Set request = New WinHttp.WinHttpRequest
    
    url = Replace(BSE_URL, "{0}", ThisWorkbook.Names("BSE_TICKER").RefersToRange.Value)
    url = Replace(url, "{1}", Format(ThisWorkbook.Names("BSE_FROM_DATE").RefersToRange.Value, "mm/dd/yyyy"))
    url = Replace(url, "{2}", Format(ThisWorkbook.Names("BSE_TO_DATE").RefersToRange.Value, "mm/dd/yyyy"))
    
    request.Open "GET", url
    request.Send
    lineSplit = Split(request.ResponseText, vbCrLf)
    
    rowCount = 0
    For Each line In lineSplit
        anchorRange.Offset(rowCount, 0).Value = line
        rowCount = rowCount + 1
    Next line
    
    DataDumpBse.Range("A:A").TextToColumns DataDumpBse.Range("A1"), xlDelimited, Comma:=True
    
End Sub



Download Solution
Download solution


References:
Link1: http://www.nseindia.com/
Link2: http://www.bseindia.com/

Saturday 7 April 2012

Skype (Go away when I am away)

Huhh.. m off the topic today….

Actually I found a very interesting trick to turn your Skype status to “Away” when you lock your desktop and back “Online” when you are back logged in…

This process is configured in 2 steps:

1. Visual Basic Scripts: There are 2 scripts in the package one to switch the status online “GetSkypeOnline.vbs” and one to switch the status back to away “GetSkypeAway.vbs”.

GetSkypeOnline.vbs
On Error Resume Next
Dim cur_skype 
Set cur_skype = CreateObject("Skype4COM.Skype")
if not (cur_skype is nothing) then 
'MsgBox cur_skype.CurrentUserStatus
 cur_skype.CurrentUserStatus = 1 'Online
end if

GetSkypeAway.vbs
On Error Resume Next
Dim cur_skype 
Set cur_skype = CreateObject("Skype4COM.Skype")
if not (cur_skype is nothing) then 
'MsgBox cur_skype.CurrentUserStatus
 cur_skype.CurrentUserStatus = 2 'Away
end if

2. Lock and Load: This a very brilliant tool I found recently with which we can capture the user activity events and fire off scripts based on events like SessionLock/SessionUnLock. Just configure the tool to fire off the correct script on the corresponding event and that’s it...




    

                
  
  

    

    C:\Documents and Settings\ampandey\Application Data\notunusual\LockAndLoad\logging.xml

    true





Your Skype contacts are now keeping a close eye when you lock and unlock your desktop… (via ur status).

Download Solution
Download solution


References:
Link1: http://www.notunusual.net/lock-and-load/
Link2: http://www.skype.com

Tuesday 3 April 2012

JIRA Excel Tool (Data Import via VBA)

JIRA is one the majorly used tools for managing large software development projects in many of the big organizations these days. It’s one the products which is quite multi-faceted, providing functionality for varied users ranging from project managers, business users, developers and more. So for the non familiar ones the better option is to explore the tool themselves.
(Link provided in the reference) 

From couple of past days I was indulge developing the tool to do a seemingly simple operation for many of the business users i.e. bring the JIRA data to excel via VBA. In spite the JIRA providing many of the functionalities required of dashboard and reporting aggregated numbers, still business people ask for data analysis where excel sneak’s in with developers like me (pat on the back).

So I was working with JIRA version 4.4 and exploring the available options provided via JIRA API ranging from SOAP (not recommended any more via JIRA) to REST (recommended). Painfully I discovered that either of the options wasn’t the best, as the requirement consisted of fields which weren’t available by either of the methods to be imported to excel via VBA (like computed or custom).

Then I tried navigating to the search area (via JQL) of the JIRA portal where I fire-bugged the request of XML option gaining the link being fired and using the knowledge gained for authentication via REST. Then I tried combining the knowledge of both in the tool I created recently, using the basic authentication mechanism for the REST API and firing the URL for the XML data containing the JQL query which is used to filter the cases in JIRA. And surprisingly it worked in my favor giving me the ability to build the following tool.


 

modJira.bas
Public Sub extractJiraQuery(userName As String, password As String)

    Dim MyRequest As New WinHttpRequest
    Dim resultXml As MSXML2.DOMDocument, resultNode As IXMLDOMElement
    Dim nodeContainer As IXMLDOMElement
    Dim rowCount As Integer, colCount As Integer
    Dim fixVersionString As String
    Dim dumpRange As Range, tempValue As Variant

    Set dumpRange = Sheet2.Range("A2")
    Sheet2.Range("A2:AZ65536").Clear
    
    Application.ScreenUpdating = False
    
    Application.StatusBar = "JIRA: Preparing header..."
    MyRequest.Open "GET", _
                   "https://JIRA_HOST_NAME/sr/jira.issueviews:searchrequest-xml/temp/SearchRequest.xml?jqlQuery=" & modCommonFunction.URLEncode(ThisWorkbook.Names("jqlQuery").RefersToRange.value) & "&tempMax=1000"

    MyRequest.setRequestHeader "Authorization", "Basic " & modCommonFunction.EncodeBase64(userName & ":" & password)

    MyRequest.setRequestHeader "Content-Type", "application/xml"

    'Send Request.
    Application.StatusBar = "JIRA: Querying request to  JIRA..."
    MyRequest.Send

    Set resultXml = New MSXML2.DOMDocument
    resultXml.LoadXML MyRequest.ResponseText

    Application.StatusBar = "JIRA: Processing Response..."
    For Each nodeContainer In resultXml.ChildNodes(2).ChildNodes(0).ChildNodes
        fixVersionString = ""
        If nodeContainer.BaseName = "issue" Then
            Application.StatusBar = "JIRA: The total issues found: " & nodeContainer.Attributes(2).text
        End If
        If nodeContainer.BaseName = "item" Then
            For Each resultNode In nodeContainer.ChildNodes
                'Debug.Print resultNode.nodeName & " :: " & resultNode.text

                If resultNode.nodeName = "fixVersion" Then
                    fixVersionString = fixVersionString & resultNode.text & " | "
                    GoTo nextNode
                End If

                If resultNode.nodeName = "aggregatetimeoriginalestimate" Then
                    tempValue = GetOriginalEstimate(resultNode)
                    dumpRange.Offset(rowCount, 23).value = tempValue
                    If tempValue <> "" Then
                        dumpRange.Offset(rowCount, 25).value = CLng(tempValue) / (60 * 60)
                    End If
                End If

                If resultNode.nodeName = "customfields" Then
                    dumpRange.Offset(rowCount, 22).value = GetStoryPoint(resultNode)
                    GoTo nextNode
                End If

                If resultNode.nodeName = "timespent" Then
                    tempValue = GetTimeSpent(resultNode)
                    dumpRange.Offset(rowCount, 24).value = tempValue
                    If tempValue <> "" Then
                        dumpRange.Offset(rowCount, 26).value = CLng(tempValue) / (60 * 60)
                    End If
                End If

                dumpRange.Offset(rowCount, GetColumnValueByName(resultNode.nodeName)).value = resultNode.text

nextNode:
            Next resultNode

            dumpRange.Offset(rowCount, 14).value = fixVersionString    ' Fix Version
            rowCount = rowCount + 1
        End If

    Next nodeContainer

    Application.ScreenUpdating = True
    
    MsgBox "The data extractions is now complete.", vbInformation, "Process Status"
End Sub

modCommonFunction.bas
Option Explicit

Public Function EncodeBase64(text As String) As String
    Dim arrData() As Byte
    arrData = StrConv(text, vbFromUnicode)

    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement

    Set objXML = New MSXML2.DOMDocument
    Set objNode = objXML.createElement("b64")

    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    EncodeBase64 = objNode.text

    Set objNode = Nothing
    Set objXML = Nothing
End Function

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

Function GetColumnValueByName(columnName As String) As Integer
    Dim iCount As Integer
    GetColumnValueByName = 100    'Default if not found
    For iCount = 0 To Sheet2.Range("A1").End(xlToRight).Column
        If Sheet2.Range("A1").Offset(0, iCount).value = columnName Then
            GetColumnValueByName = iCount
            Exit Function
        End If
    Next iCount

End Function

Function GetTimeSpent(node As IXMLDOMElement) As String

    GetTimeSpent = node.Attributes(0).text

End Function

Function GetOriginalEstimate(node As IXMLDOMElement) As String

    GetOriginalEstimate = node.Attributes(0).text

End Function

Function GetStoryPoint(node As IXMLDOMElement) As String

    Dim itm As IXMLDOMElement

    For Each itm In node.ChildNodes
        If (itm.ChildNodes(0).text = "Story Points") Then
            GetStoryPoint = itm.ChildNodes(1).text
            Exit Function
        End If
    Next itm

End Function

* The code is in two module with couple of functions specific to the XML parsing. But the main core of the tool is in modJira where the request is being fired to JIRA portal and response being recived in as XML.

Though the tool doesn’t offer the auto-complete feature as JIRA itself, I would suggest forming the JQL’s in JIRA and transferring them on to excel for import would be a good idea.

Download Solution
Download solution


References:
Link1: http://www.atlassian.com/software/jira/overview
Link1: https://developer.atlassian.com/display/JIRADEV/JIRA+REST+API+Example+-+Basic+Authentication
Link3: http://docs.atlassian.com/rpc-jira-plugin/4.4/com/atlassian/jira/rpc/soap/JiraSoapService.html
Link4: http://getfirebug.com/