ExcelVBAでGitする

:::note warn
不具合ご報告（2023/12/19）

複数のブックを同時に開き、ある一つのブックに対してこのアドインを使用すると、使用したブックを閉じてもVBEのプロジェクトエクスプローラに閉じた筈のプロジェクトが残ってしまう不具合を発見しました。プロジェクトが残ったままの状態でもう一度該当ブックを開くと、同じプロジェクトが二つ表示されてしまいます。
これは全てのブックを閉じてExcelを終了させれば解消します。
不具合を解決しようとコードを見返していますが、行き詰っています。どなたか解決策をご存じでしたらご教授ください。

あー何と皮肉にも絶望的なことになってもうた、、、:sob:
:::



そんなに絶望的か？
---
あるとき、VBAの開発環境に絶望したという記事を見て、そこで紹介されているVSCodeを使ったVBA開発環境の構築を試してみました。

https://blog.ue-y.me/vba2021/

自分の感想としては即座にデバックできないところなど、どうにも勝手が悪く返って使いづらい印象を持ちました。やはり長年慣れ親しんだVBEを捨ててVSCodeに移行するなどという気には到底なれません。
しかし、確かにコード管理がGitHubでできるのは便利だと思い、そこだけ取り入れてアドインにしてみました。以下のようなメニュー項目をVBEに追加して使用します。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/294209/08a2fcbf-91ac-5db2-7358-b86f752499a4.png)

とにかく「単純に」を目指して作りましたが、単純を積み重ねていくと自然と複雑になってしまうものですね。


必要な準備
---

#### パソコンにGitをインストール
これが無いとGitコマンドが使えません。以下のサイトでWindows用のインストーラをダウンロードしてインストールします。


https://git-scm.com/book/ja/v2/%E4%BD%BF%E3%81%84%E5%A7%8B%E3%82%81%E3%82%8B-Git%E3%81%AE%E3%82%A4%E3%83%B3%E3%82%B9%E3%83%88%E3%83%BC%E3%83%AB

`Windows Script Host`でこれを操作します。

#### GitHubアカウントの用意
当然ですが、GitHub上に自分の場所を作らなければなりません。VBAプロジェクトをプッシュする先であるリモートリポジトリを作るためにアカウントが必要です。アカウントをお持ちでない方は以下でSign upします。

https://github.com/

#### 個人用アクセストークンの入手
これはVBAを使用してGitHub APIにアクセスし、新しいリポジトリを作成する際に必要です。GitHubアカウント作成後に以下で取得します。

https://github.com/settings/tokens

<details><summary>トークン入手の手順</summary>

上のページに行ったら、`Generate new token`ボタンをクリックして`Classic`の方を選びます。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/294209/2ad92cfa-3c23-ef01-f73c-a58cc24c30ee.png)

`Note`に適当な文字列を入力、`Expiration`はデフォルトのままにしました。`Select scops`は`repo`のみチェックします。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/294209/4a18d136-e5f1-26d6-d1f5-c19058919522.png)

ページ下にスクロールして`Generate token`をクリックします。

![トーク作成ボタン.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/294209/80d37dff-700f-3493-07d3-cdf42314768e.png)

ページが変わりトークンが表示されますので、コピーボタンでコピーしておきます。作成されたトークンは一度きりしか表示されませんので注意が必要です。
</details>

トークンをレジストリに登録
---
上で取得したトークンをレジストリに登録しておきます。トークンは、出現するメッセージボックスにプレーンテキストで貼り付けます（Ctrl+Vで）。トークンは固定せずに一定期間で更新するようにすればセキュリティが高まるでしょう。（レジストリを使う時点でセキュリティに問題があると指摘される方もいらっしゃいますが）

```vb:ModuleGit.bas
' レジストリにトークンを登録
Public Sub RegisterToken()
    On Error GoTo Catch
    Dim keyStr As String
    keyStr = InputBox("GitHubの個人アクセストークンを入力してください。")
    If keyStr = "" Then Exit Sub
    Call SaveSetting("GitHub", "Token", "Classic", keyStr)
    MsgBox "GitHubの個人アクセストークンを登録しました。", vbInformation
    Exit Sub
Catch:
    MsgBox Err.Description, vbExclamation
End Sub

' レジストリからトークン用のキーを削除
Public Sub DeleteToken()
    Call DeleteSetting("GitHub", "Token", "Classic")
End Sub

' レジストリからトークンを得る
Public Function GetTokenFromRegistry() As String
    GetTokenFromRegistry = GetSetting("GitHub", "Token", "Classic")
End Function
```
VBAの標準機能である`SaveSetting`ステートメントと`DeleteSetting`ステートメントでトークンの登録と削除を行います。登録したトークンを取得するには、これも標準機能である`GetSetting`関数を使用しています。
これらは、VBA専用に用意された`HKEY_CURRENT_USER\Software\VB and VBA Program Setting`を操作するための便利な機能です。

http://officetanaka.net/excel/vba/tips/tips43.htm

リポジトリの作成
---
リポジトリの作成は以下の流れで行います。

<details><summary>1. リポジトリ名の設定</summary>

インプットボックスを表示してユーザーにリポジトリ名の入力を促します。その際に入力された値がリポジトリ名として有効かどうかを検証します。有効であればレジストリに登録すると共に戻り値としてそれを返します。

```vb:ModuleGit.bas
' リポジトリ名をレジストリに記録
Public Function SetAndThenGetReposName() As String
    Dim bookName As String: bookName = GetShortBookName(ActiveWorkbook.Name)
    Dim repoName As String: repoName = GetSetting("Excel", bookName, "RepositoryName")
    If repoName = "" Then
        repoName = InputBox("リポジトリ名を英字で入力してください。")
        If repoName = "" Then
            SetAndThenGetReposName = ""
            Exit Function
        End If
        If Not IsValidRepoName(repoName) Then
            MsgBox "リポジトリ名は無効です。" & vbCr & vbCr & _
                "リポジトリ名は英字で始まり、小文字、数字、ハイフン、アンダースコア、" & vbCr & _
                "ピリオドを含めることができ、最大256文字までです。" & vbCr & _
                "連続するハイフン、アンダースコアは使用できません。", vbInformation
            SetAndThenGetReposName = ""
            Exit Function
        End If
        Call SaveSetting("Excel", bookName, "RepositoryName", repoName)
    End If
    SetAndThenGetReposName = repoName
End Function

' GitHubのリポジトリ名の有効性をチェックする
Function IsValidRepoName(repoName As String) As Boolean
    Dim regEx As Object: Set regEx = CreateObject("VBScript.RegExp")

    ' リポジトリ名は英字で始まり、指定された文字のみ含む、最大256文字
    With regEx
        .Pattern = "^[a-zA-Z][-a-zA-Z0-9_.]*$"
        .IgnoreCase = False
        .Global = False
    End With

    ' リポジトリ名が空、長すぎる、または正規表現に一致しない場合は無効
    If Len(repoName) = 0 Or Len(repoName) > 256 Or Not regEx.Test(repoName) Then
        IsValidRepoName = False
    Else
        ' 連続するハイフン、アンダースコアをチェック
        If InStr(repoName, "--") > 0 Or InStr(repoName, "__") > 0 Then
            IsValidRepoName = False
        Else
            IsValidRepoName = True
        End If
    End If
    
    Set regEx = Nothing
End Function
```
また、ブック名の後ろにアンダースコアと8桁の日付を付けるという自分勝手な運用をしていて、レジストリにはこの部分を消去した状態で登録、日付部分を書き換えても対応できるようにしています。以下は日付部分を消去する関数です。
```vb
' 最初のアンダースコアから最後のドットまでの間の文字列を消去する
Private Function GetShortBookName(bookName As String) As String
    ' アンスコの位置
    Dim unsPos As Integer: unsPos = InStr(bookName, "_")
    ' ドットの位置
    Dim dotPos As Integer: dotPos = InStrRev(bookName, ".")
    If unsPos = 0 Or dotPos = 0 Then
        ' アンスコまたはドットが見つからない場合、元のファイル名を返す
        GetShortBookName = bookName
    Else
        ' アンスコの前の部分と、最後のドットの後の部分を結合
        GetShortBookName = Left(bookName, unsPos - 1) & Mid(bookName, dotPos)
    End If
End Function
```
</details>
<details><summary>2. ローカルリポジトリフォルダの作成</summary>

ローカルリポジトリの場所は、自分のお気に入りの開発環境である`Visual Studio 2022`のプロジェクトがデフォルトで格納される、

```
C:\Users\{ユーザー名}\Source\Repos
```

にしています。その直下に`VBA`フォルダを作り、更にその下にリポジトリ名でフォルダを作ります。

```vb:ModuleGit.bas
' ルートの親フォルダ
Public Const parentDir As String = "Source\Repos\VBA"
' ルートディレクトリを返す
Private Function GetRootDir() As String
    Dim bookName  As String: bookName = GetShortBookName(ActiveWorkbook.Name)
    Dim repoName As String: repoName = GetSetting("Excel", bookName, "RepositoryName")
    If repoName = "" Then
        GetRootDir = ""
        Exit Function
    End If
    GetRootDir = Environ$("USERPROFILE") & "\" & parentDir & "\" & repoName
End Function

' 引数のフォルダパスが存在しない場合に作る
Public Sub CreateDirIfThereNo(dirPath As String)
    Dim fso  As Object:  Set fso = CreateObject("Scripting.FileSystemObject")
    Dim dirs As Variant: dirs = Split(dirPath, "\")
    Dim i As Integer, dr As String
    For i = 0 To UBound(dirs)
        dr = dr & dirs(i) & "\"
        ' 共有ネットワークパスを考慮
        If dr = "\\" Then
            i = i + 1
            dr = dr & dirs(i) & "\"
        ElseIf Not fso.FolderExists(dr) Then
            fso.CreateFolder dr
        End If
    Next
    Set fso = Nothing
End Sub
```
</details>
<details><summary>3. Git設定ファイルの作成</summary>

`ModuleGitFilesContents`モジュールの記載内容を元に必要なGit設定ファイルを作成します。

```vb:
' Git設定ファイルの内容が埋め込まれているモジュール名
Private Const ContentsModuleName As String = "ModuleGitFilesContents"
' Git設定ファイルの作成
Public Sub GenerateGitFiles(rootDir As String, srcDir As String)
    If Application.VBE.ActiveVBProject Is Nothing Then Exit Sub
    Dim txt As String, fileName As String
    With ThisWorkbook.VBProject.VBComponents(ContentsModuleName).CodeModule
        Dim i As Long, iLine As String
        For i = 1 To .CountOfLines
            iLine = .Lines(i, 1)
            ' 対象はコメント行のみ
            If UCase(Left(Trim(iLine), 3)) = "REM" Then
                fileName = Trim(Mid(Trim(iLine), 4))
                txt = ""
            ElseIf Left(Trim(iLine), 1) = "'" Then
                ' 先頭シングルクォーテーションの除去
                iLine = Mid(RTrim(iLine), 2)
                txt = txt & iLine & vbCrLf
            End If
            ' 空白行または最終行ならテキスト作成
            If (Trim(iLine) = "" Or i = .CountOfLines) And Trim(txt) <> "" Then
                If fileName = "settings.json" Then
                    Call GenerateUTF8(txt, rootDir & "\.vscode\" & fileName)
                Else
                    Call GenerateUTF8(txt, srcDir & "\" & fileName)
                End If
            End If
        Next
    End With
End Sub
```

には`.gitattributes`、`.gitignore`、`settings.json`の内容がコメントとして埋め込まれています。`REM`行をファイル名、`'`行を本文、コメントなし行をファイルの区切り位置としてファイル化します。

```vb
Rem .gitattributes
'# Auto detect text files and perform LF normalization
'* text=auto
'
'*.bas       text    eol=crlf
'*.cls       text    eol=crlf
'*.frm       text    eol=crlf
'*.frx       binary  eol=crlf
'*.dcm       text    eol=crlf
'*.vbaproj   text    eol=crlf
'
'*.wsf       text    eol=crlf
'*.bat       text    eol=crlf
'
'*.cls linguist-language=VBA
'*.dcm linguist-language=VBA
'*.vbaproj linguist-language=INI
'
'# file encording
'*.bas working-tree-encoding=sjis
'*.cls working-tree-encoding=sjis
'*.dcm working-tree-encoding=sjis
'*.frm working-tree-encoding=sjis
'
'*.bas encoding=sjis
'*.cls encoding=sjis
'*.dcm encoding=sjis
'*.frm encoding=sjis
'
'*.bas diff=sjis
'*.cls diff=sjis
'*.dcm diff=sjis
'*.frm diff=sjis

Rem .gitignore
'*.tmp
'*.xl*
'~$*.xl*
'bin/old
'!bin/*.xl*
'!src/*

Rem settings.json
'{
'  "[markdown]": {
'    "editor.wordWrap": "on",
'    "editor.quickSuggestions": {
'      "comments": "off",
'      "strings": "off",
'      "other": "off"
'    },
'    "files.encoding": "utf8",
'  },
'  "files.encoding": "shiftjis",
'  "files.associations": {
'    "*.bas": "vb",
'    "*.cls": "vb",
'    "*.dcm": "vb",
'    "*.frm": "vb"
'  }
'}
```
</details>
<details><summary>4. binフォルダに対象ブックをコピー</summary>

`bin`フォルダにブック名を変えることなくブックをコピーします。コピー前にブックの編集内容を反映させるためにブックを保存しますので注意が必要です。

</details>
<details><summary>5. srcフォルダにコードをエキスポート</summary>

`src`フォルダにプロジェクト内のすべてのコードをエキスポートします。

```vb
' srcフォルダを指定してActiveWorkbookをExport
Public Sub Decombine(Optional includeBookName As Boolean = False)
    Dim srcPath As String
    Dim rootDir As String: rootDir = GetRootDir
    If rootDir = "" Then Exit Sub
    If includeBookName Then
        srcPath = rootDir & "\src\" & GetShortBookName(ActiveWorkbook.Name)
    Else
        srcPath = rootDir & "\src"
    End If
    Call CreateDirIfThereNo(srcPath)
    Call ExportCodeModules(ActiveWorkbook, srcPath)
End Sub

' プロジェクト内の全てのモジュールをsrcフォルダにExport
Private Sub ExportCodeModules(ByVal xBook As Workbook, ByVal srcDir As String)
    On Error GoTo Catch
    Dim vbPjt As VBIDE.VBProject: Set vbPjt = xBook.VBProject
    Dim vbCmp As VBIDE.VBComponent
    For Each vbCmp In vbPjt.VBComponents
        Select Case vbCmp.Type
            Case vbext_ct_StdModule
                vbCmp.Export srcDir & "\" & vbCmp.Name & ".bas"
            Case vbext_ct_MSForm
                vbCmp.Export srcDir & "\" & vbCmp.Name & ".frm"
            Case vbext_ct_ClassModule
                vbCmp.Export srcDir & "\" & vbCmp.Name & ".cls"
            Case vbext_ct_Document
                vbCmp.Export srcDir & "\" & vbCmp.Name & ".dcm"
        End Select
    Next
    GoTo Finally
Catch:
    OutputError "ExportCodeModules"
Finally:
    ' 何もしない
End Sub
```
</details>
<details><summary>6. リモートリポジトリの作成</summary>

リモートリポジトリはGitHub APIで作成します。前述した個人用アクセストークンをHTTPオブジェクトのリクエストヘッダーに添えます。アクセス修飾子はprivateに固定しています。
リモートリポジトリが無事に作成されればリモートリポジトリのURLを取得することができます。
取得したURLはレジストリに登録します。

```vb:ModuleGit.bas
Public Function CreateRemoteRepos(bookName As String, repoName As String) As Boolean
    On Error GoTo Catch
    Dim rt As Boolean: rt = False
    
    ' トークンを取得
    Dim token As String: token = GetTokenFromRegistry()
    If Trim(token) = "" Then
        MsgBox "個人用アクセストークンを登録してください。", vbInformation
        CreateRemoteRepos = rt
        Exit Function
    End If

    ' HTTPオブジェクトを生成
    Dim http     As Object: Set http = CreateObject("MSXML2.XMLHTTP")

    ' GitHub APIのURL
    Dim url      As String: url = "https://api.github.com/user/repos"
    http.Open "POST", url, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "token " & token

    ' JSONリクエストボディを作成（アクセス修飾子はprivate）
    Dim jsonBody As String: jsonBody = "{""name"":""" & repoName & """, ""private"": true}"

    ' リクエストを送信
    Call http.send(jsonBody)

    ' 結果を表示
    If http.Status = 201 Then
        Dim json    As Object: Set json = JsonConverter.ParseJson(http.responseText)
        Dim repoUrl As String: repoUrl = json("html_url")
        Call SaveSetting("Excel", bookName, "RepositoryURL", repoUrl)
        Call GitCmd(Init)
        MsgBox "リモートリポジトリが作成されました。" & vbCr & vbCr & repoUrl, vbInformation
        rt = True
    Else
        MsgBox "リモートリポジトリの作成に失敗しました。" & vbCr & vbCr & _
            "Status: " & http.Status & vbCr & http.responseText, vbExclamation
        rt = False
    End If
    GoTo Finally
Catch:
    MsgBox Err.Description, vbExclamation
    rt = False
Finally:
    Set http = Nothing
    Set json = Nothing
    CreateRemoteRepos = rt
End Function
```
レスポンスからURLを取得するためのJSONパーサーは、有名な以下のライブラリを使用しています。


https://github.com/VBA-tools/VBA-JSON


ここにある`JsonConverter.bas`をアドインプロジェクトに追加しただけです。

</details>
<details><summary>7. リポジトリの初期化と最初のコミット＆プッシュ</summary>

前述の`CreateRemoteRepos`関数の中で後述する`GitCmd`関数を呼び出して行っています。最初のコミットのコメントは「リポジトリ開始」に固定されています。リモートリポジトリ作成後にそのリポジトリのページで案内される初期設定のためのGitコマンド群をそのまま実行しています。
</details>

```vb:ModuleGit.bas
Public Sub CreateNewRepository()
    ' リポジトリ名を設定する
    Dim repoName As String: repoName = SetAndThenGetReposName
    If repoName = "" Then Exit Sub
    
    ' ローカルリポジトリフォルダ作成
    Dim repoDir As String: repoDir = GetRootDir
    If repoDir = "" Then Exit Sub
    Call CreateDirIfThereNo(repoDir)
    ' ローカルリポジトリフォルダ内のサブフォルダ作成
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(repoDir & "\.vscode") Then fso.CreateFolder repoDir & "\.vscode"
    If Not fso.FolderExists(repoDir & "\bin") Then fso.CreateFolder repoDir & "\bin"
    If Not fso.FolderExists(repoDir & "\bin\old") Then fso.CreateFolder repoDir & "\bin\old"
    If Not fso.FolderExists(repoDir & "\src") Then fso.CreateFolder repoDir & "\src"
    Dim bookName As String: bookName = GetShortBookName(ActiveWorkbook.Name)
    Dim srcDir As String: srcDir = repoDir & "\src"
    If Not fso.FolderExists(srcDir) Then fso.CreateFolder srcDir

    ' Git設定ファイル作成
    Call GenerateGitFiles(repoDir, srcDir)
    
    ' ブックを保存してbinフォルダにコピー
    ActiveWorkbook.Save
    Call fso.CopyFile(ActiveWorkbook.FullName, repoDir & "\bin\" & ActiveWorkbook.Name, True)
    Set fso = Nothing
    
    ' srcフォルダにCodeModuleをExport
    Call Decombine
    
    ' リモートリポジトリの作成
    If CreateRemoteRepos(bookName, repoName) Then
        MsgBox bookName & " 用のリポジトリの準備ができました。", vbInformation
    End If
End Sub
```

ステージ、コミット、プッシュ
---
ステージ、コミット、プッシュはいずれも`Windows Script Host`を使ってGitコマンドを実行する流れになります。以下の`GitCmd`関数は各工程で必要な処理があればそれをして、`RunCmd`関数にテキストのGitコマンドを投げます。`RunCmd`ではコマンド実行と共に何か出力が返って来たらそれをテキストファイルにリダイレクトし、その内容を戻り値として返すというワンパターンの処理を行っています。

```vb:ModuleGit.bas
' GitCmd引数用
Public Enum GitCommand
    Init
    Status
    Stage
    Commit
    Push
End Enum

' Gitコマンドを実行
Public Function GitCmd(cmd As GitCommand, Optional arg As String = Empty, Optional isPowerShell As Boolean = False) As Integer
    On Error GoTo Catch
    Dim rootDir As String: rootDir = GetRootDir
    If rootDir = "" Then
        MsgBox """" & ActiveWorkbook.Name & """" & vbLf & vbLf & "リポジトリ名が登録されていません。", vbInformation
        Exit Function
    End If
    
    Call ChDir(rootDir)
    
    Dim rt As String
    Select Case cmd
    Case Init
        Dim bookName As String: bookName = GetShortBookName(ActiveWorkbook.Name)
        Dim repoUrl  As String: repoUrl = GetSetting("Excel", bookName, "RepositoryURL")
        If repoUrl = "" Then
            MsgBox "リモートリポジトリを作成してください。", vbInformation
            GoTo Finally
        End If
        rt = RunCmd("git init")
        rt = rt & vbCr & RunCmd("git add .")
        rt = rt & vbCr & RunCmd("git commit -m ""リポジトリ開始""")
        rt = rt & vbCr & RunCmd("git branch -M main")
        rt = rt & vbCr & RunCmd("git remote add origin " & repoUrl)
        rt = rt & vbCr & RunCmd("git push -u origin main")
    Case Status
        rt = RunCmd("git status")
    Case Stage
        If MsgBox(ActiveWorkbook.Name & " の変更をステージします。" & vbLf & vbLf & _
                  ActiveWorkbook.Name & " の保存とエクスポートを伴います。", vbInformation + vbOKCancel) = vbOK Then
            Application.DisplayAlerts = False
            If ActiveWorkbook.path = rootDir & "\bin" Then
                MsgBox "binフォルダ内の" & ActiveWorkbook.Name & "を開いたままステージ出来ません。" & vbLf & _
                       "ステージはキャンセルされました。, vbInformation"
                GoTo Finally
            Else
                ActiveWorkbook.Save
                Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
                Call fso.CopyFile(ActiveWorkbook.FullName, rootDir & "\bin\" & ActiveWorkbook.Name, True)
                Call Decombine
                rt = RunCmd("git add .")
            End If
        Else
            GoTo Finally
        End If
    Case Commit
        If arg = Empty Then
            arg = InputBox("コミットのメッセージを入力してください。")
            If arg = "" Then GoTo Finally
            If MsgBox("""" & arg & """" & vbLf & vbLf & "このメッセージでコミットします。", vbInformation + vbOKCancel) = vbCancel Then
                GoTo Finally
            End If
        End If
        rt = RunCmd("git commit -m """ & arg & """")
    Case Push
        Dim mBranch As String
        If arg = Empty Then mBranch = "main"
        rt = RunCmd("git push origin " & mBranch)
    End Select
    Debug.Print rt
    GoTo Finally
Catch:
    OutputError "GitCmd"
Finally:
    Application.DisplayAlerts = True
End Function
```
```vb
' コマンドプロンプトでcmd引数の内容を実行、リダイレクトして文字化けに対応
Private Function RunCmd(cmd As String, Optional showInt As Integer = 0, Optional toWait As Boolean = True) As String
    On Error GoTo Catch
    Dim fso     As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim msgPath As String: msgPath = Environ$("temp") & "\gitTmp.log"
    Dim errPath As String: errPath = Environ$("temp") & "\gitErr.log"
    Dim wsh     As Object: Set wsh = CreateObject("WScript.Shell")
    Dim rt      As Long:   rt = wsh.Run("cmd /c " & cmd & " > " & msgPath & " 2> " & errPath, showInt, toWait)
    
    Dim msg As String
    If rt = 0 Then
        msg = CurDir & " (正常終了 - " & cmd & ")"
    Else
        msg = CurDir & " (異常終了 - " & cmd & ")"
    End If
    
    Dim msgStream As Object: Set msgStream = CreateObject("ADODB.Stream")
    msgStream.Type = 2
    msgStream.Charset = "utf-8"
    msgStream.Open
    msgStream.LoadFromFile msgPath
    Dim msgText As String
    msgText = msgStream.ReadText
    msgStream.Close: Set msgStream = Nothing
    
    Dim errStream As Object: Set errStream = CreateObject("ADODB.Stream")
    errStream.Type = 2
    errStream.Charset = "utf-8"
    errStream.Open
    errStream.LoadFromFile errPath
    Dim errText As String
    errText = errStream.ReadText
    errStream.Close: Set errStream = Nothing
    
    Select Case True
    Case Trim(msgText) = "" And Trim(errText) = ""
        ' 何もしない
    Case Trim(msgText) <> "" And Trim(errText) = ""
        msg = msg & vbCr & msgText
    Case Trim(msgText) = "" And Trim(errText) <> ""
        msg = msg & vbCr & errText
    Case Trim(msgText) <> "" And Trim(errText) <> ""
        msg = msg & vbCr & msgText & vbCr & errText
    End Select
    
    GoTo Finally
Catch:
    OutputError "RunCmd"
Finally:
    If fso.FileExists(msgPath) Then fso.DeleteFile msgPath
    If fso.FileExists(errPath) Then fso.DeleteFile errPath
    Set fso = Nothing
    Set wsh = Nothing
    RunCmd = Trim(msg)
End Function
```


VBEにメニュー登録
---
最後に、今まで見てきたプロシージャがワンクリックで使えるようにVBEのメニューに登録します。

```vb:ThisWorkbook.dcm
Private newEventsItems() As EventsItem

Private Type ItemProperties
    FullName As String
    Caption As String
    OnAction As String
    FaceId As Long
    BeginGroup As Boolean
End Type

Private Sub Workbook_Open()
    ' VBEのメニューバーを取得（メニューバーのIndexは、固定値で「1」）
    Dim VBEMenuBar As CommandBar
    Set VBEMenuBar = Application.VBE.CommandBars(1)
    
    ' 新しいメニューを作成
    Dim newMenu As CommandBarControl
    Set newMenu = VBEMenuBar.Controls.Add(Type:=msoControlPopup)
    
    ' メニューのキャプションを設定
    newMenu.Caption = "Git管理(&G)"
    
    ' メニューアイテムの設定値を構造体の配列に格納
    Dim prop() As ItemProperties: prop = MenuItemSetting
    ' イベントアイテムクラスを構造体を使って作成
    ReDim newEventsItems(LBound(prop) To UBound(prop))
    Dim i As Long, newMenuItem As CommandBarControl
    For i = LBound(prop) To UBound(prop)
        ' メニューにアイテムを追加
        Set newMenuItem = newMenu.Controls.Add(Type:=msoControlButton)
        With prop(i)
            newMenuItem.Caption = .Caption
            newMenuItem.OnAction = "'" & .FullName & "'!" & .OnAction
            newMenuItem.FaceId = .FaceId
            newMenuItem.BeginGroup = .BeginGroup
        End With
        ' イベントアイテムクラスの登録
        Set newEventsItems(i) = New EventsItem: Call newEventsItems(i).Initialize(newMenuItem)
    Next i
End Sub

```
メニューの内容は`ItemProperties`構造体に設定値を代入していき、配列にします。配列をループで回して`EventsItem`クラスを登録していきます。これらは上から順番にメニューに登録されます。メニューアイテムを増減させる場合、`MaxIndex`定数をメニューアイテム数に合わせる必要があります。
```vb:ThisWorkbook.dcm
Private Const MaxIndex As Long = 6

Private Function MenuItemSetting() As ItemProperties()
    ' 【要注意】MaxIndexをメニュー数にする
    Dim prop(1 To MaxIndex) As ItemProperties 
    
    Dim i As Long
    
    ' ---- メニュー開始 ------------------------------------------------------------
    ' OnActionの設定値にはモジュール名も必要
    
    i = i + 1
    prop(i).Caption = "リポジトリの作成"
    prop(i).OnAction = "ModuleGit.CreateNewRepository"
    prop(i).FaceId = 610
    prop(i).BeginGroup = False
    
    i = i + 1
    prop(i).Caption = "変更をステージ(&S)"
    prop(i).OnAction = "ModuleGit.GitStage"
    prop(i).FaceId = 535
    prop(i).BeginGroup = True

    i = i + 1
    prop(i).Caption = "変更をコミット(&C)"
    prop(i).OnAction = "ModuleGit.GitCommit"
    prop(i).FaceId = 534
    prop(i).BeginGroup = False

    i = i + 1
    prop(i).Caption = "変更をプッシュ(&P)"
    prop(i).OnAction = "ModuleGit.GitPush"
    prop(i).FaceId = 533
    prop(i).BeginGroup = False
    
    i = i + 1
    prop(i).Caption = "トークンを登録"
    prop(i).OnAction = "ModuleGit.RegisterToken"
    prop(i).FaceId = 277
    prop(i).BeginGroup = True
    
    i = i + 1
    prop(i).Caption = "トークンを削除"
    prop(i).OnAction = "ModuleGit.DeleteToken"
    prop(i).FaceId = 1786
    prop(i).BeginGroup = False
    
    ' ---- メニュー終了 ------------------------------------------------------------
    
    Dim FullName As String: FullName = ThisWorkbook.FullName
    For i = LBound(prop) To UBound(prop)
        prop(i).FullName = FullName
    Next
    
    MenuItemSetting = prop

End Function
```
```vb:EventsItem.cls
Private WithEvents MenuItem As VBIDE.CommandBarEvents

Private Sub Class_Terminate()
    Set MenuItem = Nothing
End Sub

Public Sub Initialize(ByVal ctl As Office.CommandBarControl)
    Set MenuItem = Application.VBE.Events.CommandBarEvents(ctl)
End Sub

Private Sub MenuItem_Click(ByVal sender As Object, handled As Boolean, CancelDefault As Boolean)
    Application.Run sender.OnAction
End Sub
```
```vb:ModuleGit.bas
Public Sub GitStage()
    Call GitCmd(Stage)
End Sub

Public Sub GitCommit()
    Call GitCmd(Commit)
End Sub

Public Sub GitPush()
    Call GitCmd(Push)
End Sub
```

注意点
---
コード内にCP932に在ってShift-JISに無い文字があるとエラーとなります。
①、②、③、№、㎡などです。これらを他の文字に置き換えれば解決します。
複数のGitHubアカウントには対応していません。

おわりに
---
<br>このアドインのリポジトリへのリンクは、不具合発見のため消去しました:fearful:<br><br>

    

~~これのリポジトリは下記になります~~:sunglasses:

https://github.com/

~~binフォルダにあるGitAdmin.xlamが実体です。これをダウンロードしてお使いのパソコンのアドインフォルダに保存し、Excelのオプション設定で有効なアドインとしてチェックすれば使えるようになります。ご利用は自己責任でよろしくお願いいたします~~:bow_tone1: