Excel VBA | API 連携風のログ＆エラー管理テンプレ

VBA

2025.11.20

こちらは、Excel VBAで「API連携風のログ＆エラー管理テンプレート」を構築するための設計例です。API呼び出しのような処理を模倣しつつ、ログ記録・エラー管理・再実行性・通知を備えた堅牢な構成になっています。

構成概要
データ構造（Excelシート）
1. シート名: RequestLog
コア処理テンプレート（VBA）
Outlookメール送信関数
再実行設計
拡張アイデア

構成概要

機能	内容
API呼び出し	疑似的な外部連携（例: IDごとに処理）
ログ記録	成功/失敗、レスポンス、ステータス、タイムスタンプ
エラー管理	エラー番号・内容・行番号・再実行フラグ
再実行制御	NG行のみ再処理可能な設計
通知	処理結果をメール送信（Outlook）

データ構造（Excelシート）

シート名: RequestLog

A列	B列	C列	D列	E列	F列	G列
ID	ステータス	レスポンス	エラー番号	エラー内容	実行日時	再実行対象

ステータス: OK / NG / 未処理
再実行対象: TRUE/FALSE（NGのみTRUE）

コア処理テンプレート（VBA）

Sub RunApiBatch()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("RequestLog")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim r As Long, id As String
    Dim okCount As Long, ngCount As Long, failList As String
    Dim ts As String: ts = Format(Now, "yyyy-mm-dd HH:NN:SS")

    For r = 2 To lastRow
        If ws.Cells(r, "B").Value = "OK" Then GoTo NextRow
        If ws.Cells(r, "G").Value <> True Then GoTo NextRow

        id = Trim(ws.Cells(r, "A").Value)
        If Len(id) = 0 Then GoTo NextRow

        On Error GoTo ApiErr
        ' 疑似API呼び出し
        Dim resp As String
        resp = CallFakeApi(id)

        ws.Cells(r, "B").Value = "OK"
        ws.Cells(r, "C").Value = resp
        ws.Cells(r, "F").Value = ts
        ws.Cells(r, "G").Value = False
        okCount = okCount + 1
        GoTo NextRow

ApiErr:
        ws.Cells(r, "B").Value = "NG"
        ws.Cells(r, "C").Value = ""
        ws.Cells(r, "D").Value = Err.Number
        ws.Cells(r, "E").Value = Err.Description
        ws.Cells(r, "F").Value = ts
        ws.Cells(r, "G").Value = True
        failList = failList & "Row " & r & ": " & id & " → " & Err.Description & vbCrLf
        ngCount = ngCount + 1
        Err.Clear
NextRow:
    Next r

    ' 通知（成功/失敗件数）
    Dim subject As String, body As String
    subject = "[APIバッチ] 実行結果 OK=" & okCount & " NG=" & ngCount
    body = "日時: " & ts & vbCrLf & _
           "成功件数: " & okCount & vbCrLf & _
           "失敗件数: " & ngCount & vbCrLf & _
           IIf(ngCount > 0, "失敗詳細:" & vbCrLf & failList, "失敗なし")
    Call SendMail("ops@example.com", subject, body)
End Sub

Function CallFakeApi(ByVal id As String) As String
    ' 疑似API処理（ランダムで失敗）
    If Rnd() < 0.2 Then Err.Raise 500, , "APIエラー: ID=" & id
    CallFakeApi = "Success for " & id
End Function

Sub RunApiBatch()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("RequestLog")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim r As Long, id As String
    Dim okCount As Long, ngCount As Long, failList As String
    Dim ts As String: ts = Format(Now, "yyyy-mm-dd HH:NN:SS")

    For r = 2 To lastRow
        If ws.Cells(r, "B").Value = "OK" Then GoTo NextRow
        If ws.Cells(r, "G").Value <> True Then GoTo NextRow

        id = Trim(ws.Cells(r, "A").Value)
        If Len(id) = 0 Then GoTo NextRow

        On Error GoTo ApiErr
        ' 疑似API呼び出し
        Dim resp As String
        resp = CallFakeApi(id)

        ws.Cells(r, "B").Value = "OK"
        ws.Cells(r, "C").Value = resp
        ws.Cells(r, "F").Value = ts
        ws.Cells(r, "G").Value = False
        okCount = okCount + 1
        GoTo NextRow

ApiErr:
        ws.Cells(r, "B").Value = "NG"
        ws.Cells(r, "C").Value = ""
        ws.Cells(r, "D").Value = Err.Number
        ws.Cells(r, "E").Value = Err.Description
        ws.Cells(r, "F").Value = ts
        ws.Cells(r, "G").Value = True
        failList = failList & "Row " & r & ": " & id & " → " & Err.Description & vbCrLf
        ngCount = ngCount + 1
        Err.Clear
NextRow:
    Next r

    ' 通知（成功/失敗件数）
    Dim subject As String, body As String
    subject = "[APIバッチ] 実行結果 OK=" & okCount & " NG=" & ngCount
    body = "日時: " & ts & vbCrLf & _
           "成功件数: " & okCount & vbCrLf & _
           "失敗件数: " & ngCount & vbCrLf & _
           IIf(ngCount > 0, "失敗詳細:" & vbCrLf & failList, "失敗なし")
    Call SendMail("ops@example.com", subject, body)
End Sub

Function CallFakeApi(ByVal id As String) As String
    ' 疑似API処理（ランダムで失敗）
    If Rnd() < 0.2 Then Err.Raise 500, , "APIエラー: ID=" & id
    CallFakeApi = "Success for " & id
End Function

Outlookメール送信関数

Function SendMail(toAddr As String, subjectText As String, bodyText As String) As Boolean
    On Error GoTo ErrHandler
    Dim olApp As Object, olMail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    With olMail
        .To = toAddr
        .Subject = subjectText
        .Body = bodyText
        .Send
    End With
    SendMail = True
    Exit Function
ErrHandler:
    SendMail = False
End Function

Function SendMail(toAddr As String, subjectText As String, bodyText As String) As Boolean
    On Error GoTo ErrHandler
    Dim olApp As Object, olMail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    With olMail
        .To = toAddr
        .Subject = subjectText
        .Body = bodyText
        .Send
    End With
    SendMail = True
    Exit Function
ErrHandler:
    SendMail = False
End Function