ChatGPTでVBA（プログラム）作成

コーヒー


ChatGPTの使いこなし方を模索したいと、仕事の合間に仕事の手伝いをしてもらっています。
ピタッと嵌まる使い方が出来た事もあれば、時間だけ掛かって満足いかないこともあり。プロンプトエンジニアとしての知見の蓄積が必要かなと思う毎日です。
さて、今回はエクセルのVBAをChatGPT君に書いて貰った話。
「たったの1行も自分ではVBAを書かず、VBAを完成させる」という事に挑戦しました。

まずは出来上がったコードをご覧頂きましょう。

Sub ImportXMLData()
    Dim xmlFolder As String
    Dim xmlFile As String
    Dim ws As Worksheet
    Dim fd As Office.FileDialog

    Set ws = ThisWorkbook.Sheets("データシート")
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd
        .Title = "XMLファイルが保存されているフォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            xmlFolder = .SelectedItems(1)
        Else
            MsgBox "フォルダが選択されませんでした。"
            Exit Sub
        End If
    End With

    xmlFile = Dir(xmlFolder & "\*.xml")

    Do While xmlFile <> ""
        ' XMLファイルを処理
        Call ProcessXMLFile(xmlFolder & "\" & xmlFile, ws)
        
        xmlFile = Dir ' 次のファイルを取得
    Loop
End Sub


Sub ProcessXMLFile(ByVal xmlFilePath As String, ByRef ws As Worksheet)
    Dim xmlDoc As Object, recordNode As Object, recordNodes As IXMLDOMNodeList
    Dim lastRow As Long, i As Long
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.Async = False
    xmlDoc.Load (xmlFilePath)
    
    If xmlDoc.parseError.ErrorCode <> 0 Then
        MsgBox "XML解析エラー: " & xmlDoc.parseError.reason
        Exit Sub
    End If
    
    ' recordノードのリストを取得
    Set recordNodes = xmlDoc.SelectNodes("//record")
    For i = 0 To recordNodes.Length - 1
        Set recordNode = recordNodes(i)
        
        ' 各recordごとに最後の行を更新
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

        ' A列からD列のデータを設定

        ' org_name
        On Error Resume Next ' ノードが存在しない場合のエラーを無視
        ws.Cells(lastRow, 1).Value = xmlDoc.SelectSingleNode("//report_metadata/org_name").Text
        If Err.Number <> 0 Then ws.Cells(lastRow, 1).Value = "－"
        On Error GoTo 0
    
        ' domain
        On Error Resume Next
        ws.Cells(lastRow, 4).Value = xmlDoc.SelectSingleNode("//policy_published/domain").Text
        If Err.Number <> 0 Then ws.Cells(lastRow, 4).Value = "－"
        On Error GoTo 0
    
        ' date_range/beginを日本時間に変換して設定
        Dim beginUnixTime As Long
        beginUnixTime = Val(GetNodeText(xmlDoc.SelectSingleNode("//report_metadata/date_range/begin"), "."))
        If beginUnixTime <> 0 Then ' UNIX時刻が0ではない場合のみ変換
            ws.Cells(lastRow, 2).Value = UnixTimeToJST(beginUnixTime)
        Else
            ws.Cells(lastRow, 2).Value = "－"
        End If

        ' date_range/endを日本時間に変換して設定
        Dim endUnixTime As Long
        endUnixTime = Val(GetNodeText(xmlDoc.SelectSingleNode("//report_metadata/date_range/end"), "."))
        If endUnixTime <> 0 Then ' UNIX時刻が0ではない場合のみ変換
            ws.Cells(lastRow, 3).Value = UnixTimeToJST(endUnixTime)
        Else
            ws.Cells(lastRow, 3).Value = "－"
        End If
        
        
        ' E列: record/row/source_ip
        ws.Cells(lastRow, 5).Value = GetNodeText(recordNode, "row/source_ip")

        ' F列: record/row/count
        ws.Cells(lastRow, 6).Value = GetNodeText(recordNode, "row/count")

        ' G列: record/row/policy_evaluated/disposition
        ws.Cells(lastRow, 7).Value = GetNodeText(recordNode, "row/policy_evaluated/disposition")

        ' H列: record/row/policy_evaluated/dkim
        ws.Cells(lastRow, 8).Value = GetNodeText(recordNode, "row/policy_evaluated/dkim")

        ' I列: record/row/policy_evaluated/spf
        ws.Cells(lastRow, 9).Value = GetNodeText(recordNode, "row/policy_evaluated/spf")

        ' J列: record/identifiers/envelope_to
        ws.Cells(lastRow, 10).Value = GetNodeText(recordNode, "identifiers/envelope_to")

        ' K列: record/identifiers/envelope_from
        ws.Cells(lastRow, 11).Value = GetNodeText(recordNode, "identifiers/envelope_from")

        ' L列: record/identifiers/header_from
        ws.Cells(lastRow, 12).Value = GetNodeText(recordNode, "identifiers/header_from")

        ' M列: record/auth_results/dkim/domain
        ws.Cells(lastRow, 13).Value = GetNodeText(recordNode, "auth_results/dkim/domain")

        ' N列: record/auth_results/dkim/selector
        ws.Cells(lastRow, 14).Value = GetNodeText(recordNode, "auth_results/dkim/selector")

        ' O列: record/auth_results/dkim/result
        ws.Cells(lastRow, 15).Value = GetNodeText(recordNode, "auth_results/dkim/result")

        ' P列: record/auth_results/spf/domain
        ws.Cells(lastRow, 16).Value = GetNodeText(recordNode, "auth_results/spf/domain")

        ' Q列: record/auth_results/spf/scope
        ws.Cells(lastRow, 17).Value = GetNodeText(recordNode, "auth_results/spf/scope")

        ' R列: record/auth_results/spf/result
        ws.Cells(lastRow, 18).Value = GetNodeText(recordNode, "auth_results/spf/result")
    Next i
End Sub

' ヘルパー関数: ノードからテキストを取得し、ノードが存在しない場合は "－" を返す
Function GetNodeText(ByRef node As IXMLDOMNode, ByVal xPath As String) As String
    On Error Resume Next
    GetNodeText = node.SelectSingleNode(xPath).Text
    If Err.Number <> 0 Then GetNodeText = "－"
    On Error GoTo 0
End Function
Function UnixTimeToJST(unixTime As Long) As Date
    Const Epoch As Long = 25569 ' 1970年1月1日のExcelの日付値
    Const SecondsPerDay As Long = 86400 ' 1日の秒数
    Const JSTOffset As Integer = 9 ' 日本時間のUTCオフセット（時間）
    
    ' UNIX時刻を日付に変換し、JSTオフセットを加算する
    UnixTimeToJST = Epoch + (unixTime / SecondsPerDay) + (JSTOffset / 24)
End Function

こんな感じです。
これが何をするVBAかというと、以下の通りです。

  • あるフォルダにあるDMARCレポートのXMLファイルを全て読み込む。

  • 内容をレコード毎に対応するエクセル上の列にインポートする。

これだけです。

DMARCレポートってなに？

DMARCレポートって何？と思う方も多いと思いますが、ざっくり説明すると「お前のドメイン（例えばinst-web.com）から送られてきたメール、怪しかったから拒絶したぜ」という報告書です（笑）
SPF、DKIMという迷惑メール対策の認証が導入され、DMARCの認証結果のレポートが送信先のメールサーバーから受け取れるようになったんです。
因みにDMARCレポートはこんな感じ。

<?xml version="1.0"?>
<feedback>
	<version>0.1</version>
	<report_metadata>
		<org_name>通販サイト</org_name>
		<email>postmaster@通販サイト.com</email>
		<report_id>01234567890123456789</report_id>
		<date_range>
			<begin>1709683200</begin>
			<end>1709769600</end>
		</date_range>
	</report_metadata>
	<policy_published>
		<domain>inst-web.com</domain>
		<adkim>r</adkim>
		<aspf>r</aspf>
		<p>none</p>
		<sp>none</sp>
		<pct>100</pct>
		<fo>0</fo>
	</policy_published>
	<record>
		<row>
			<source_ip>xxx.xxx.xxx.xxx</source_ip>
			<count>1</count>
			<policy_evaluated>
				<disposition>none</disposition>
				<dkim>pass</dkim>
				<spf>fail</spf>
			</policy_evaluated>
		</row>
		<identifiers>
			<envelope_from>inst-web.com</envelope_from>
			<header_from>inst-web.com</header_from>
		</identifiers>
		<auth_results>
			<dkim>
				<domain>inst-web.com</domain>
				<result>pass</result>
			</dkim>
			<spf>
				<domain>inst-web.com</domain>
				<result>softfail</result>
			</spf>
		</auth_results>
	</record>
</feedback>

ね、何が書いてあるかさっぱり分からないでしょ？（笑）
これが会社のドメインだと10件とか来るの。結構多い。
「身元の正しいメールを受信しましたよ！」という報告もあれば「怪しいメールも来たよ！」という報告もあります。
怪しいメール、つまり「当社のドメインを偽って送られている迷惑メール」なのかもしれない…
実はまだそこは不勉強です。

ChatGPTへお願いする前に

実際にChatGPTにお願いする前に、色々準備をしました。
何を、どのようにしてほしいかまとめる。要件定義ってやつですかね？

A列	rport_metadata/org_name	
B列	rport_metadata/date_ragne/begin	
C列	rport_metadata/date_ragne/end	
D列	policy_published/domain	
E列	record/row/source_ip	
F列	record/row/count	
G列	record/row/policy_evaluated/disposition	
H列	record/row/policy_evaluated/dkim	
I列	record/row/policy_evaluated/spf	
J列	record/identifiers/envelope_to	
K列	record/identifiers/envelope_from	
L列	record/identifiers/header_from	
M列	record/auth_results/dkim/domain	
N列	record/auth_results/dkim/selector	
O列	record/auth_results/dkim/result	
P列	record/auth_results/spf/domain	
Q列	record/auth_results/spf/scope	
R列	record/auth_results/spf/result

XMLファイルの構造を見て、エクセルの何列にデータを入れてほしいかを検討しておきました。今回話がスムーズに行ったのは多分ここが大きかった。

プロンプトのやりとり

ではさっそくやってきましょう。

こんな風に入力し、XMLファイルのサンプルを3つ添付しました。

まずはこんな感じ。
「XMLファイルの内容を確認してみましょうか？」と問いかけてくれる繊細さ（笑）

実際にはここで具体的なコードも提示してくれました。それを実行したところ、フォルダ名の設定がないので読み込むことが出来ませんでした。
じゃあ、という事で。

文句も言わずに実装してくれます。
そしてやってみたらこう。

「生成AIなんだからいっぱつで作れよ！」というのは大きな間違いですね。一緒に作業していきましょう（笑）
ちゃんと問題点を認識して改善してくれます。

Sub ProcessXMLFile(ByVal xmlFilePath As String, ByRef ws As Worksheet)
    Dim xmlDoc As Object, recordNode As Object, recordNodes As IXMLDOMNodeList
    Dim lastRow As Long, i As Long
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.Async = False
    xmlDoc.Load(xmlFilePath)
    
    If xmlDoc.parseError.ErrorCode <> 0 Then
        MsgBox "XML解析エラー: " & xmlDoc.parseError.reason
        Exit Sub
    End If
    
    ' recordノードのリストを取得
    Set recordNodes = xmlDoc.SelectNodes("//record")
    For i = 0 To recordNodes.Length - 1
        Set recordNode = recordNodes(i)
        
        ' 各recordごとに最後の行を更新
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

        ' A列からD列のデータを設定
        ' この部分は以前の説明でカバーされています
        
        ' E列のデータを設定
        ws.Cells(lastRow, 5).Value = GetNodeText(recordNode, "row/source_ip")
        
        ' F列からR列までのデータを設定
        ' この部分は各列に対応するXMLのパスに基づいてデータを設定する必要があります
        ' 例:
        ' ws.Cells(lastRow, 6).Value = GetNodeText(recordNode, "適切なXPath")
        ' ...
    Next i
End Sub

' ヘルパー関数: ノードからテキストを取得し、ノードが存在しない場合は "－" を返す
Function GetNodeText(ByRef node As IXMLDOMNode, ByVal xPath As String) As String
    On Error Resume Next
    GetNodeText = node.SelectSingleNode(xPath).Text
    If Err.Number <> 0 Then GetNodeText = "－"
    On Error GoTo 0
End Function

その後数回のテストとフィードバックを受けて概ね良い感じに。
上のコードの「F列からR列までのデータ」が省略されていますね？
これも考えてもらう事にしました。

' E列: record/row/source_ip
ws.Cells(lastRow, 5).Value = GetNodeText(recordNode, "row/source_ip")

' F列: record/row/count
ws.Cells(lastRow, 6).Value = GetNodeText(recordNode, "row/count")

' G列: record/row/policy_evaluated/disposition
ws.Cells(lastRow, 7).Value = GetNodeText(recordNode, "row/policy_evaluated/disposition")

' H列: record/row/policy_evaluated/dkim
ws.Cells(lastRow, 8).Value = GetNodeText(recordNode, "row/policy_evaluated/dkim")

' I列: record/row/policy_evaluated/spf
ws.Cells(lastRow, 9).Value = GetNodeText(recordNode, "row/policy_evaluated/spf")

' J列: record/identifiers/envelope_to
ws.Cells(lastRow, 10).Value = GetNodeText(recordNode, "identifiers/envelope_to")

' K列: record/identifiers/envelope_from
ws.Cells(lastRow, 11).Value = GetNodeText(recordNode, "identifiers/envelope_from")

' L列: record/identifiers/header_from
ws.Cells(lastRow, 12).Value = GetNodeText(recordNode, "identifiers/header_from")

' M列: record/auth_results/dkim/domain
ws.Cells(lastRow, 13).Value = GetNodeText(recordNode, "auth_results/dkim/domain")

' N列: record/auth_results/dkim/selector
ws.Cells(lastRow, 14).Value = GetNodeText(recordNode, "auth_results/dkim/selector")

' O列: record/auth_results/dkim/result
ws.Cells(lastRow, 15).Value = GetNodeText(recordNode, "auth_results/dkim/result")

' P列: record/auth_results/spf/domain
ws.Cells(lastRow, 16).Value = GetNodeText(recordNode, "auth_results/spf/domain")

' Q列: record/auth_results/spf/scope
ws.Cells(lastRow, 17).Value = GetNodeText(recordNode, "auth_results/spf/scope")

' R列: record/auth_results/spf/result
ws.Cells(lastRow, 18).Value = GetNodeText(recordNode, "auth_results/spf/result")

べろべろべろべろっとちゃんと考えてくれます。
こんな感じでVBAが完成しました。

私なら3日～4日の作業が1時間に

私ノンプログラマーです。VBAを組んだことは何度もありますが、その都度調べてはコピペ、エラーが出ては修正という作業を繰り返してやっと「プログラムらしきモノ」が出来て「何となく動いている」という状況になります。
それが今回は僅か1時間にも満たない作業で見やすいVBAが完成しました。
これは使いこなさない手はないよね！

この記事が気に入ったらサポートをしてみませんか？