Attribute VB_Name = "MySQL2Excel"
Option Explicit
'Author: Stephen Moon
'Last Modified: 6/3/09
'Program: P4Excel
' The program makes a database query against a MySQL database which was
' created by running Track2SQL.php script against the Perforce log
' When a query is made, it needs the name of the databse, the server, as well
' as the user name. It's hard-coded at the moment, but it would be nice
' to add a dialog which asks for the above required information.
'
' Currently, it is an Excel Add-In program which presents the user with a dialog
' which allows the user to specify the number of users to analyze.
' Upon the specification on the number of users, the users with the longest computes
' corresponding to the number are imported into Excel spreadsheet and a bar chart is
' generated.
'
' For future developments, it would be nice to generate graphs automatically for other
' often asked queries against the Perforce log. Also, it would be nice to limit
' the scope of the analysis within a given date range.
Sub showMySQL2Excel()
frmMySQL2Excel.Show 'Displays form
End Sub
Sub MySQL2Excel_Main()
Dim sheetName As String
Call connectDB(sheetName) 'connects and bring in the data
Call graphQuery(sheetName) 'graphs the data
End Sub
Sub connectDB(sheetName As String)
Dim oConn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sqlCommand As String
Dim str As String
Dim rng As Range
Dim strv As Variant
Dim strGroup() As String
Dim strToken() As String
Dim strCount As Integer
Dim strTokenCtr As Integer
Dim i, r As Integer
Dim userToken() As String
'connects against a localhost with a logname, "smoonlog" as a user, root.
oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
"SERVER=localhost;" & _
"DATABASE=smoonlog;" & _
"USER=root;" & _
"PASSWORD=bruno;" & _
"Option=3"
'sql query for the users with longest compute time
sqlCommand = "SELECT process.processKey,user,cmd, FROM_UNIXTIME(time) AS time," & _
"Max(readHeld + writeHeld)/1000 AS compute " & _
"FROM tableUse JOIN process USING (processKey) GROUP BY tableUse.processKey " & _
"ORDER BY compute DESC LIMIT " & frmMySQL2Excel.tbUsers.Value & ";"
' sqlCommand = "SELECT process.processKey,user,cmd, FROM_UNIXTIME(time) AS time," & _
' "Max(readHeld + writeHeld) - Max(readWait + writeWait) AS compute " & _
' "FROM tableUse JOIN process USING (processKey) GROUP BY tableUse.processKey " & _
' "ORDER BY compute DESC LIMIT 10;"
'
Call deleteChart 'delete the previously created charts
Sheets.Add
ActiveSheet.Name = "Longest_Compute"
sheetName = ActiveSheet.Name
Set rng = Cells(3, 1)
rs.Open sqlCommand, oConn
strGroup = Split(rs.GetString, vbCr)
'Print the columns headings
Cells(1, 1) = "Longest Compute"
For i = 0 To rs.Fields.Count - 1
Cells(2, i + 1) = rs.Fields.Item(i).Name
Next
'Print queried data
r = 0
For strCount = LBound(strGroup) To UBound(strGroup)
strToken = Split(strGroup(strCount), vbTab)
For strTokenCtr = LBound(strToken) To UBound(strToken)
If (InStr(strToken(strTokenCtr), "user-")) Then
userToken = Split(strToken(strTokenCtr), "-")
Debug.Print userToken(1)
rng.Offset(r, strTokenCtr) = userToken(1)
Else
rng.Offset(r, strTokenCtr) = strToken(strTokenCtr)
End If
Next
r = r + 1
Next
Call graphQuery(sheetName) 'graph the imported data.
rs.Close
oConn.Close
Set oConn = Nothing
Set rs = Nothing
End Sub
Sub graphQuery(sheetName As String)
Const startRow As Long = 2
Const startCol As Long = 1
Dim trng As Range
Dim r, c As Long
Dim data_1, data_2, data_3, data_4 As String
Dim endCol, endCol2, endCol3, endCol4 As Long
Dim startAddress_1, endAddress_1 As String
Dim startAddress_2, endAddress_2 As String
Dim startAddress_3, endAddress_3 As String
Dim startAddress_4, endAddress_4 As String
Dim sname As String
Set trng = Sheets(sheetName).Cells(startRow, startCol)
'four different columns of data
data_1 = "user"
data_2 = "compute"
data_3 = "cmd"
data_4 = "time"
'Find user
r = 0
c = 0
Do While Not IsEmpty(trng.Offset(r, c))
If (trng.Offset(r, c) = data_1) Then
endCol = c
ElseIf (trng.Offset(r, c) = data_2) Then
endCol2 = c
ElseIf (trng.Offset(r, c) = data_3) Then
endCol3 = c
ElseIf (trng.Offset(r, c) = data_4) Then
endCol4 = c
End If
c = c + 1
Loop
Do While Not IsEmpty(trng.Offset(r, endCol))
r = r + 1
Loop
startAddress_1 = convert2Address(startRow, endCol + 1)
endAddress_1 = convert2Address(r + 1, endCol + 1)
startAddress_2 = convert2Address(startRow, endCol2 + 1)
endAddress_2 = convert2Address(r + 1, endCol2 + 1)
startAddress_3 = convert2Address(startRow, endCol3 + 1)
endAddress_3 = convert2Address(r + 1, endCol3 + 1)
startAddress_4 = convert2Address(startRow, endCol4 + 1)
endAddress_4 = convert2Address(r + 1, endCol4 + 1)
'Charts.Add
'ActiveChart.SetSourceData Source:=Sheets(sheetName). _
'Range(f_startAddress & ":" & f_endAddress, s_startAddress & ":" & s_endAddress)
'ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="c" & sheetName
Dim myChart As ChartObject
Set myChart = ActiveSheet.ChartObjects.Add _
(Left:=250, Width:=600, Top:=0, Height:=400)
startAddress_1 = convert2Address(startRow + 1, endCol + 1)
endAddress_1 = convert2Address(r + 2, endCol + 1)
sname = convert2Address(startRow, endCol2 + 1)
startAddress_2 = convert2Address(startRow + 1, endCol2 + 1)
endAddress_2 = convert2Address(r + 2, endCol2 + 1)
startAddress_3 = convert2Address(startRow + 1, endCol3 + 1)
endAddress_3 = convert2Address(r + 2, endCol3 + 1)
startAddress_4 = convert2Address(startRow + 1, endCol4 + 1)
endAddress_4 = convert2Address(r + 2, endCol4 + 1)
With myChart.Chart
.SeriesCollection.NewSeries
.ChartType = xlBarClustered
.HasTitle = True
.ChartTitle.Characters.Text = sheetName
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Offending Users"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Compute Time in Seconds"
.SeriesCollection(1).Name = Sheets(sheetName).Range(sname)
.SeriesCollection(1).XValues = Sheets(sheetName).Range(startAddress_1 & ":" & endAddress_1)
'.SeriesCollection(2).XValues = Sheets(sheetName).Range(startAddress_1 & ":" & endAddress_1)
.SeriesCollection(1).Values = Sheets(sheetName).Range(startAddress_3 & ":" & endAddress_3)
'.SeriesCollection(3).XValues = Sheets(sheetName).Range(startAddress_1 & ":" & endAddress_1)
.SeriesCollection(1).Values = Sheets(sheetName).Range(startAddress_4 & ":" & endAddress_4)
.SeriesCollection(1).Values = Sheets(sheetName).Range(startAddress_2 & ":" & endAddress_2)
End With
End Sub
Public Function trimAll(ByVal strInput As String, Optional boolRemoveTabs As Boolean = True) As String
'strinput = input string
'boolRemoveTabs = if the input string has tabs
'This function trims white spaces of a string. If it sees a space longer than two, it reduces down to one.
'In case of tab, you need provide another parameter in the "Optional param"
Const conTwoSpaces = " "
Const conSpace = " "
strInput = Trim$(strInput)
'If there are tabs in the string
If boolRemoveTabs Then
strInput = Replace(strInput, vbTab, conSpace)
End If
Do Until InStr(strInput, conTwoSpaces) = 0
strInput = Replace(strInput, conTwoSpaces, conSpace)
Loop
'final string should have tokens delimited by only one space
trimAll = strInput
End Function
'==========================================================================================================
'Function findChart(ChartName As String) As Boolean
'Input => chartName = Name of Excel chart name
'Output => Return True or False based on the existence of the input chart name.
'
'==========================================================================================================
Function findChart(chartName As String) As Boolean
Dim j As Integer
j = Sheets.Count
Do While Not j < 1
If (Sheets(j).Name = chartName) Then
findChart = True
End If
j = j - 1
Loop
End Function
'==========================================================================================================
'Function convert2Address(row, column) As String
'Input => Row and column integers are values from cells(r,c) (i.e. absolute not relative cell referencing)
'Output => String value which will have corresponding alphabetic characters from A to IV.
'
'==========================================================================================================
Public Function convert2Address(r As Long, c As Long) As String
If c >= 1 And c <= 26 Then
convert2Address = Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 27 And c <= 52 Then
convert2Address = Chr(65) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 53 And c <= 78 Then
convert2Address = Chr(65 + 1) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 79 And c <= 104 Then
convert2Address = Chr(65 + 2) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 105 And c <= 131 Then
convert2Address = Chr(65 + 3) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 132 And c <= 158 Then
convert2Address = Chr(65 + 4) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 159 And c <= 185 Then
convert2Address = Chr(65 + 5) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 186 And c <= 212 Then
convert2Address = Chr(65 + 6) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 213 And c <= 239 Then
convert2Address = Chr(65 + 7) & Chr(((c - 1) Mod 26) + 65) & r
ElseIf c >= 240 And c <= 256 Then
convert2Address = Chr(65 + 8) & Chr(((c - 1) Mod 26) + 65) & r
End If
End Function
'==================================================================================================================
'Delete the sheets and charts created by the prior run =
'==================================================================================================================
Sub deleteChart()
Dim a As Integer
'the programmatically created sheets and charts in the previous run are deleted.
a = Sheets.Count
Do While Not a < 1
If (genSheets(Sheets(a).Name)) Then
Sheets(a).Delete
End If
a = a - 1
Loop
End Sub
Function genSheets(ByVal strtext As String) As Boolean
genSheets = (strtext Like "Longest_Compute*")
End Function