【VBA】VBAマクロのオリジナル雛型

ポイント

・可能な限りMVCモデルのようにする
・可能な限りグローバルな変数は定義せずローカル変数を使用する
・プロシージャの引数には「参照渡し(ByRef)」 or 「値渡し(ByVal)」を記載する

モジュール「MainModule」

・コントローラー及びビュー
・ボタンから呼び出すSubプロシージャを定義
　┗画面描画/イベント/確認メッセージ/自動計算の抑止、抑止解除
　┗入力チェック
　┗ビジネスロジックの呼び出し、戻り値チェック
　┗MsgBoxの出力

モジュール「CreateXXModule」等

・モデル
・Subプロシージャから呼び出すビジネスロジックを定義
・可能ならばPublicなプロシージャは1つのみにする
・参照渡しの引数でオブジェクトをもらい、値を設定する
・戻り値はエラー構造体

モジュール「PublicModule」

・エラー構造体を定義
・可能な限り他の定義はしない
　┗ファイル名、シート名、カラム名はOK

前提

シート、モジュールは以下。

VBAマクロのオリジナル雛型

●モジュール「MainModule」

Option Explicit

Sub Button_Clici()
    
    Const SHEET_NAME As String = "XXXツール"
    Dim startTime As Date
    Dim endTime As Date
    Dim ws As Worksheet
    Dim isPathExist As String
    Dim inputFolder As String
    Dim buttonText As String
    Dim errInfo As errInfo
    'ビジネスロジックで作成するデータの器
    Dim dicData As Object
    
    On Error GoTo Catch
    
    startTime = Now 
    '初期化処理
    Call init(False)   

    '入力フォルダの取得
    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
    inputFolder = ws.Range("B3").Value

    '入力必須チェック
    If inputFolder = "" Then
        MsgBox "入力フォルダが入力されていません", vbExclamation, "入力チェックエラー"
        Exit Sub
    End If

    'フォルダの存在チェック
    isPathExist = Dir(inputFolder, vbDirectory)
    If isPathExist = "" Then
        MsgBox "入力フォルダが存在しません", vbExclamation, "入力チェックエラー"
        Exit Sub
    End If

    'ボタンに設定されている文字列を取得
    buttonText = ws.Buttons(Application.Caller).Text
    
    If buttonText = "XXを実行" Then
        'ビジネスロジックの呼び出し
        Set dicData = CreateObject("Scripting.Dictionary")
        errInfo = businessLogic(inputFolder, dicData)

        'エラー有無の判定
        If errInfo.number <> 0 Then
        
            '後片付け
            Set dicData = Nothing
            Set ws = Nothing
            Call init(True)

            'エラー内容出力
            Call errMsgBox(errInfo)

            Exit Sub
        End If 

        '次のビジネスロジックの呼び出し
        '・・・
        '・・・
        '・・・

        'エラー有無の判定


    ElseIf buttonText = "hogehogeを実行" Then
        'ビジネスロジックの呼び出し
        '・・・
        '・・・
        '・・・

        'エラー有無の判定

        '次のビジネスロジックの呼び出し
        '・・・
        '・・・
        '・・・

        'エラー有無の判定

    End If

    '後片付け
    Set dicData = Nothing
    Set ws = Nothing
    Call init(True)
    
    endTime = Now
    
    MsgBox "完了しました!" & vbCrLf & _
           "開始時間：" & startTime & vbCrLf & _
           "終了時間：" & endTime, vbInformation, "確認"

    Exit Sub

Catch:
    '後片付け
    Set dicData = Nothing
    Set ws = Nothing
    Call init(True)

    'エラー内容出力
    errInfo.number = Err.number
    errInfo.description = Err.description
    Call errMsgBox(errInfo)
End Sub

'初期化処理
'画面描画/イベント/確認メッセージ/自動計算の抑止、抑止解除
Private Function init(status As Boolean)
    
    With Application
        .ScreenUpdating = status
        .EnableEvents = status
        .DisplayAlerts = status
        
        If status Then
            .Calculation = xlCalculationAutomatic
        Else
            .Calculation = xlCalculationManual
        End If
    End With

End Function

'エラー内容出力
Private Function errMsgBox(ByRef errInfo As errInfo)
    
    Dim errorMessage As String
    
    errorMessage = "エラーが発生しました" & vbCrLf & _
                    "エラー番号: " & errInfo.number & vbCrLf & _
                    "エラー内容: " & errInfo.description & vbCrLf
    MsgBox errorMessage, vbCritical, "エラー"
    
End Function

● モジュール「CreateXXModule」等

Option Explicit

'ビジネスロジックなFunctionプロシージャ
Public Function businessLogic(ByVal inputFolder As String, _
                              ByRef dicData As Object) _
                              As errInfo

    Dim fso As Object
    Dim file As Object
    Dim errInfo As errInfo
    
    On Error GoTo Catch

    '初期化
    errInfo.number = 0
    errInfo.description = ""
    Set fso = CreateObject("Scripting.FileSystemObject")

    'ビジネスロジック
    '値渡しの引数を使用して、参照渡しの引数にデータを設定
    For Each file In fso.GetFolder(inputFolder).Files
        If Not dicData.Exists(file.name) Then
            dicData.add file.name, ""
        End If
    Next

    '後片付け
    Set fso = Nothing
    
    Exit Function
    
Catch:
    '後片付け
    Set fso = Nothing

    'エラー構造体を設定して戻り値で返す
    errInfo.number = Err.number
    errInfo.description = Err.description
    businessLogic = errInfo    
End Function

●モジュール「PublicModule」

'エラー構造体
Type errInfo
    number As Integer
    description As String
End Type