UCO-Tech（MySQLの情報取得用マクロ作ってみた）

Tweet

MySQLの情報取得用のマクロを作ってみました。

MySQLステータスチェックマクロ

取りたい情報を全部とれるか、といったら、
このまま使ったら本当に最低限だけです。
ただ、実行させたいSQLは追加できるので、
不足があれば後から足していけばOKです。

2018/3/3追記：
取ると有益そうな情報を取得するSQLを追加しました。
SHOW ENGINE INNODB STATUSが取れないのが痛い・・・
MySQLステータスチェックマクロ_v2

マクロで書くメリットとしては、
Excelのピボットテーブルでのまとめをする際、
データが元々Excelに入っていればすごくやりやすい、
という点があります。

監視用ツールって色々ありますが、
生の数字を持ち、かつグラフのフォーマットも自由に変えられる、
という点では、なんだかんだExcelは相当優秀です。

もちろん、MySQL Enterprise Monitor, Percona Monitoring and Managementなどの環境があり、
これを使いこなせるならそちらを使った方がいいに決まっているのですが、
普段作業しているWindowsの環境で、
手軽にMySQLの稼働統計を取ってみたい、
というくらいであれば、
サーバー側にコンポーネントを入れたり、
監視用のソフトを入れたりする必要がなく、
単にWindowsのPCとExcel（とMySQLのODBCドライバ）があれば良いので、
使う機会はまあなくはないかな、と思いました。

あと、使ってみて思いましたが、SHOW GLOBAL STATUSとか変数絞らずにやると、
系列数が255を超えてピボットテーブルで表示できないですね。
その辺はまあ、もともとのデータをSHOW GLOBAL STATUS LIKE ‘XXX’とかで絞るか、
一旦255を超える系列数でピボットテーブル作って、フィルターかなんかで絞るか、
でしょうか。

日々の運用を少しだけ楽にしよう、
と思ったらExcel VBAって結構必要で、
Excel VBA書く練習、という意味でも結構面白かったです。

次は他の言語で、sysstatがあることを前提にOS情報も付与する、
とかも考えてみてもいいかな、
と思いました（やるとは言ってない）。

では。

P.S.
最後に、Excel VBAのコードを載せておきます。
マクロ入りファイルをダウンロードするのはキモイ、という人もいると思うので・・・。

Option Explicit

Sub 実行制御()
    Dim START_TIME As Variant
    Dim END_TIME As Variant
    
    If Range("I6").Value = "" Then
        START_TIME = Time
        Call MySQLステータスチェック
        END_TIME = Time
        Application.OnTime Now() + (Range("I5").Value - (TimeValue(END_TIME) - TimeValue(START_TIME))), "実行制御"
    Else
        MsgBox "定期実行を終了します。"
        Exit Sub
    End If
End Sub

Sub MySQLステータスチェック()

    Dim CON As Object
    Dim RS As Object
    Dim SQL As Variant
    Dim RS_FIELDS As Object
    Dim DRIVER_CELL As String
    Dim HOST_CELL As String
    Dim PORT_CELL As String
    Dim USER_CELL As String
    Dim MYSQL_PASSWORD As String
    Dim RESULT_SECTION_START_AT As Range
    Dim RESULT_START_AT As Range
    Dim SQL_INFO_START_AT As Range
    Dim i As Integer
    Dim j As Integer
    Dim SQL_LIST_ARRAY As Variant
    Dim EXEC_DATETIME As String
    
    ''''''''''''''
    ' コンフィグ '
    ''''''''''''''
    DRIVER_CELL = Range("C5").Value
    HOST_CELL = Range("C6").Value
    PORT_CELL = Range("C7").Value
    USER_CELL = Range("C8").Value
    
    Set RESULT_SECTION_START_AT = Range("B13")
    Set SQL_INFO_START_AT = Sheets("情報取得SQL").Range("B3")
    
    ''''''''
    ' MAIN '
    ''''''''
    Sheets("表紙").Activate
    
    If Range("C9").Value = "" Then
        
        MYSQL_PASSWORD = InputBox("MySQLの " & USER_CELL & " ユーザのパスワードを入力してください", "MySQLパスワード入力")
        
        If MYSQL_PASSWORD = "" Then
            MsgBox "パスワードが入力されませんでした。プログラムを終了します。"
            Exit Sub
        End If
    
    Else
        
        MYSQL_PASSWORD = Range("C9").Value
    
    End If
    
    EXEC_DATETIME = Now
    
    Set CON = CreateObject("ADODB.Connection")
    On Error GoTo ErrorTrap

    CON.Open _
        "DRIVER={" & DRIVER_CELL & "};" & _
        " SERVER=" & HOST_CELL & ";" & _
        " PORT=" & PORT_CELL & ";" & _
        " USER=" & USER_CELL & ";" & _
        " PASSWORD=" & MYSQL_PASSWORD & ";"

    SQL_LIST_ARRAY = Sheets("情報取得SQL").Range(SQL_INFO_START_AT, SQL_INFO_START_AT.End(xlDown)).Value

    For Each SQL In SQL_LIST_ARRAY

        Set RESULT_START_AT = Cells(RESULT_SECTION_START_AT.Row + RESULT_SECTION_START_AT.Offset(2, 1).CurrentRegion.Rows.count + 1, RESULT_SECTION_START_AT.Column + 1)
        
        Set RS = CON.Execute(SQL)
        Set RS_FIELDS = RS.FIELDS

        If RESULT_START_AT.CurrentRegion.Rows.count = 1 Then
            With RESULT_SECTION_START_AT
                .Value = SQL
                .Font.Bold = True
                .Font.Underline = xlUnderlineStyleSingle
            End With
            
            RESULT_START_AT.Value = "実行日時"
            For i = 0 To RS_FIELDS.count - 1
                Cells(RESULT_START_AT.Row, RESULT_START_AT.Column + 1 + i) = RS_FIELDS(i).Name
            Next
        
            With Range(RESULT_START_AT, RESULT_START_AT.End(xlToRight)).Interior
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.249977111117893
            End With
        End If
       
        ' CopyFromRecordsetでは一部データが欠損することがあったので以下の方法。
        i = 1
        Do Until RS.EOF
            
            Cells(RESULT_START_AT.Row + i, RESULT_START_AT.Column) = EXEC_DATETIME
            
            For j = 1 To RS.FIELDS.count
                Cells(RESULT_START_AT.Row + i, RESULT_START_AT.Column + j).Value = RS.FIELDS(j - 1).Value
            Next j
            
            i = i + 1
            
            RS.MoveNext
        
        Loop

        Call 罫線引き(RESULT_START_AT.CurrentRegion)
        
        Set RESULT_SECTION_START_AT = RESULT_SECTION_START_AT.Offset(0, RESULT_START_AT.CurrentRegion.Columns.count + 2) ' 横に結果を並べたければこちら
        
        RS.Close
        Set RS = Nothing
        
    Next
    
    CON.Close
    Set CON = Nothing
    
Exit Sub
 
ErrorTrap:
    MsgBox (Err.Description)

End Sub

Sub 罫線引き(TARGET_CELL As Range)
    TARGET_CELL.Borders(xlDiagonalDown).LineStyle = xlNone
    TARGET_CELL.Borders(xlDiagonalUp).LineStyle = xlNone
    With TARGET_CELL.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With TARGET_CELL.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With TARGET_CELL.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With TARGET_CELL.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With TARGET_CELL.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With TARGET_CELL.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

Exit Sub

ErrorTrap:
    MsgBox (Err.Description)

End Sub

Sub 結果削除()
    Range(Rows("12:12"), Rows("12:12").End(xlDown)).Delete Shift:=xlUp
End Sub

Tweet