「VBAでJSONを読み込みたいんだけど、標準機能だとどうにもならない…」と手が止まっていませんか？

結論から言うと、ExcelVBAでJSONを扱うなら「VBA-JSON」という定番ライブラリを入れるのが一番ラクです

やることはシンプルで、JsonConverter.bas というファイルを1つ取り込んで、参照設定を1つ入れるだけ、あとは ParseJson でJSONを読み込んで、ConvertToJson でJSONを書き出せます

この記事では、VBA-JSONの導入から実際の使い方(パース・生成・配列やネストへのアクセス・ループ処理)まで、初心者の方にも分かるように順を追って解説していきます、つまずきポイントとFAQ、AIにコードを書いてもらうコツもまとめているので、必要なところだけ拾い読みでも大丈夫です

VBAでJSONを扱うなら VBA-JSON が定番

まず大前提として、VBAには標準でJSONを扱う機能がありません

Excelには CSV を読む機能はあっても、JSONをそのまま「項目ごとに取り出す」みたいなことは素のVBAだとできないんですよね

そこで使うのが、オープンソースのライブラリ「VBA-JSON」です

GitHubの VBA-tools/VBA-JSON で公開されていて、JSON界隈ではかなり知られた定番です、最新は v2.3.1 で、WindowsのExcelでもMacのExcelでも動きます

使う関数は基本的にこの2つだけ覚えればOKです

• ParseJson … JSON文字列を、VBAで扱えるデータ(Dictionary / Collection)に変換する(=読み込む)
• ConvertToJson … VBAのデータを、JSON文字列に変換する(=書き出す)

「読み込む」と「書き出す」の往復、これだけです、難しそうに見えて中身はシンプルなので安心してください

VBAでJSONを扱う場面はどんなとき？

そもそも「ExcelでJSONなんて使うの？」と思うかもしれませんが、最近のWeb APIはJSONで返ってくるのがほぼ標準なので、意外と日常業務の中で出番があります

たとえばこんなケースです

• 為替レートや天気予報のWeb APIを叩いてExcelに取り込む
• WebサービスからダウンロードしたデータをVBAで集計する
• 取引先のシステムとJSON形式でデータをやり取りする
• WordPressや社内システムのREST APIを操作する

VBA-JSONを使えるようになると、Excel完結の作業に外部データを取り込める幅が一気に広がります、普段の集計シートに「最新のデータを自動で引っ張ってくる」ような仕組みを足せるイメージですね

実際にWeb APIへリクエストを送ってJSONを受け取る流れは、eBay APIにVBAでリクエストを送る方法を解説した記事でも具体例を扱っているので、API連携をやってみたい方はあわせてどうぞ

そもそもJSONって何？という人向けの基礎

「JSONって言葉は聞くけど、よく分かってない」という方のために、ここで一度ざっくり整理しておきます、もう分かってる方は読み飛ばしてOKです

JSON(JavaScript Object Notation)は、テキストベースのデータ交換フォーマットです

Web APIからデータを取得するとき、他システムとのデータやり取りなど、いろんな場面で使われています、軽量で人間にも機械にも読みやすいのが特徴ですね

JSONの基本構造と記述ルール

細かいルールはいくつかありますが、まず押さえておきたいのはこのあたりです

• 項目名は「”」(ダブルクォーテーション)で囲む
• 文字列も「”」(ダブルクォーテーション)で囲む
• 数値は小数点を含めてそのまま表記(クォーテーション不要)
• 真偽値(Boolean)は「true」「false」のどちらか ※小文字、「”」は付けない
• Null値は「null」 ※小文字、「”」は付けない
• 「[ ]」で囲んだ配列の中も、上記と同じルール

形としては「"キー": 値」のセットが基本で、複数のデータを { } で囲んだものを「オブジェクト」、順序のあるデータの並びを [ ] で囲んだものを「配列」と呼びます

このあたりの言葉は、VBA-JSONを使うときに何度も出てくるので、なんとなく頭に入れておくと後がスムーズです

JSONのサンプルをExcelの表で考えてみる

JSONはCSVほど一目で分かる形式じゃないので、サンプルと一緒に見方を説明します、この記事ではずっとこのデータを例に進めていきます

たとえばこんなJSON形式のデータがあるとして

[{"name":"Javeo","birthdate":{"year":2000,"month":1,"day":1},"height":180,"weight":70,"favorite_foods":["Meat","Vegetables"],"glasses":true},{"name":"Javelin","birthdate":{"year":2002,"month":2,"day":2},"height":150,"weight":null,"favorite_foods":["Sweets"],"glasses":false}]

一行だと分かりづらいので、整形するとこうなります(VSCodeなどのエディタで簡単に整形できます)

[
  {
    "name": "Javeo",
    "birthdate": {
      "year": 2000,
      "month": 1,
      "day": 1
    },
    "height": 180,
    "weight": 70,
    "favorite_foods": [
      "Meat",
      "Vegetables"
    ],
    "glasses": true
  },
  {
    "name": "Javelin",
    "birthdate": {
      "year": 2002,
      "month": 2,
      "day": 2
    },
    "height": 150,
    "weight": null,
    "favorite_foods": [
      "Sweets"
    ],
    "glasses": false
  }
]

これをExcel的に表にすると、こんなイメージになります

つまりJSONをざっくり言うと、項目と値が対になっていて、「{ }」が階層を、「[ ]」が配列のデータ群を表していると思えばOKです

この「JaveoとJavelinの2人分のデータ」を、これからVBA-JSONで取り出していきます

VBA-JSONの導入手順(2026年版)

ここが一番大事なパートです、導入でつまずく人が多いので、順番にやっていきましょう

やることは大きく分けて2つ、「JsonConverter.basのインポート」と「参照設定」だけです

STEP

ライブラリのダウンロード

GitHubのVBA-tools/VBA-JSONリポジトリにアクセス

STEP

ファイルを探す

ページ内にある「JsonConverter.bas」をダウンロード

※何年も更新されていませんが、文字列を分解するだけのプログラムで特に改良点がないってだけなので気にせずどうぞ

STEP

VBAへのインポート

VBAで使えるようにするにはVBEの画面でインポートするだけ

プロジェクトエクスプローラー
右クリック→「ファイルのインポート」

もしくは「JsonConverter.bas」をプロジェクトエクスプローラーへドラッグ&ドロップでもOK

STEP

Microsoft Scripting Runtime に参照設定する

VBA-JSONを動かすには参照設定が要ります

VBA-JSONは内部で「Dictionary」という、キーと値をセットで扱うデータの入れ物を使っています、このDictionaryをそのまま書くスタイル(早期バインディングと言います)で動かすために、Microsoft Scripting Runtime への参照設定が必要になります

設定はVBEのメニューからで、手順はこうです

1. VBEのメニューで「ツール → 参照設定」を開く
2. 一覧から「Microsoft Scripting Runtime」を探す
3. チェックボックスにチェックを入れて「OK」を押す

これを忘れると、コードを実行したときに「ユーザー定義型は定義されていません」というエラーが出ます、後ろのFAQでも触れますが、この参照設定はかなりの確率でハマるので先に済ませておくのがおすすめです

Mac の Excel で使う場合

MacのExcelには Microsoft Scripting Runtime が無いので、参照設定の代わりに同じ作者の「VBA-Dictionary」というライブラリを一緒に入れます

VBA-tools/VBA-Dictionary から Dictionary.cls をダウンロードして、JsonConverter.bas と同じようにインポートすればOKです、WindowsとMacの両方で動かしたいときも、参照設定ではなくこのVBA-Dictionaryを使う形にしておくと安心ですね

ここまでできたら準備は完了です、いよいよ実際にJSONを扱っていきます

ParseJson でJSONを解析(パース)してみる

JSON形式のテキストを、VBAで扱えるデータ構造(DictionaryやCollection)に変換することを「解析(パース)」と言います

このパースが、ParseJson 関数を使えばたった一行で完了します

まずはWeb APIからJSONを取ってきてパースする、いちばんよくある形のサンプルです

' /// 事前準備 ///
' VBEの [ツール] > [参照設定] から下記にチェックを入れる
' ・Microsoft Scripting Runtime   (Dictionary用、VBA-JSONに必須)
' ・Microsoft XML, v6.0           (APIを叩く場合)
Sub GetJsonData()
    Dim http As Object
    Dim jsonText As String
    Dim parsedData As Object ' 解析後のデータ格納用

    ' Web APIからJSONデータを取得(例)
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://javeo.jp/wp-json/test/v1/data", False
    http.send
    jsonText = http.responseText

    ' ここがVBA-JSONの本体、JSONを解析
    Set parsedData = ParseJson(jsonText)

    ' 解析したデータをデバッグ出力
    Debug.Print "名前: " & parsedData(1)("name")
    Debug.Print "身長: " & parsedData(1)("height")

    Set http = Nothing
    Set parsedData = Nothing
End Sub

長く見えるかもしれませんが、VBA-JSONを使っている箇所は、結局このたった一行だけです

Set parsedData = ParseJson(jsonText)

この一行を通すことで、最初のサンプルにあった「長いただの文字列」が、parsedData(1)("name") といった具合に要素を指定してデータを取り出せる構造に変わります

APIを使わず、手元の文字列をそのままパースして試すこともできます、まずは動きを確かめたいときはこちらが手っ取り早いです

Sub ParseSample()
    Dim jsonText As String
    Dim parsedData As Object

    ' 動作確認用に文字列を直接用意
    jsonText = "[{""name"":""Javeo"",""height"":180}]"

    Set parsedData = ParseJson(jsonText)

    Debug.Print parsedData(1)("name") ' → Javeo
    Debug.Print parsedData(1)("height") ' → 180
End Sub

VBAの中で「”」を書くときは「””」と2つ重ねる必要があるので、そこだけ少し読みづらいですが、やっていることは「文字列をパースして取り出す」だけです

パースしたJSONから値を取り出す(配列・オブジェクト・ネスト)

ここがVBA-JSONを使ううえで一番つまずきやすく、そして一番大事なところです

ポイントは、パース後のデータが「Dictionary」と「Collection」の2種類に化けているという点です

• JSONの「{ }」(オブジェクト)→ Dictionary になる(キー名で取り出す)
• JSONの「[ ]」(配列)→ Collection になる(番号で取り出す)

この区別さえ分かれば、あとは指定の仕方が決まります、サンプルの「JaveoとJavelinのデータ」を例に、ひとつずつ見ていきましょう

配列(Collection)は番号で取り出す

サンプルのJSONは全体が「[ ]」で囲まれた配列なので、パース直後の parsedData はCollectionになっています

Collectionは「何番目」という番号(インデックス)で要素を取り出します、VBAのCollectionは1番から始まるのがポイントで、0番からじゃないので注意です

' 1人目(Javeo)のデータを取り出す
Set firstPerson = parsedData(1)

' 2人目(Javelin)のデータを取り出す
Set secondPerson = parsedData(2)

オブジェクト(Dictionary)はキー名で取り出す

取り出した1人分のデータ(parsedData(1))は「{ }」のオブジェクトなので、こちらはDictionaryです

Dictionaryは番号ではなく、キー名(項目名)を指定して値を取り出します

' 1人目の名前と身長
Debug.Print parsedData(1)("name")   ' → Javeo
Debug.Print parsedData(1)("height") ' → 180

' 真偽値もそのまま取れる
Debug.Print parsedData(1)("glasses") ' → True

parsedData(1)("name") は「配列の1番目(Collection)→ その中のnameキー(Dictionary)」という読み方になります、カッコが連続するのは、この2段階を一気に書いているからなんですね

ネスト(入れ子)は同じ要領でつなげる

サンプルの birthdate は、中にさらに year / month / day を持つ「入れ子のオブジェクト」です、こういうネストも、考え方は同じでカッコをつなげるだけです

' 1人目の生年月日(birthdateの中のyear)
Debug.Print parsedData(1)("birthdate")("year")  ' → 2000
Debug.Print parsedData(1)("birthdate")("month") ' → 1

' 配列の中の値(favorite_foodsの1個目)
Debug.Print parsedData(1)("favorite_foods")(1) ' → Meat

コツは、「{ }が来たらキー名」「[ ]が来たら番号」をJSONの形に合わせて交互に書いていくだけ、整形したJSONを見ながら指でたどると間違えにくいです

ループでまとめて処理する

実際の業務では「全員分をシートに書き出す」みたいに、繰り返し処理(ループ)で回すことがほとんどです

配列(Collection)は For Each でぐるっと回せます

Sub WriteToSheet()
    Dim parsedData As Object
    Dim person As Object
    Dim i As Long

    Set parsedData = ParseJson(jsonText) ' jsonTextは取得済みとする

    i = 1
    ' 配列の要素(1人分のデータ)を1件ずつ取り出す
    For Each person In parsedData
        Cells(i, 1).Value = person("name")
        Cells(i, 2).Value = person("height")
        Cells(i, 3).Value = person("birthdate")("year")
        i = i + 1
    Next person
End Sub

キー名が分からないオブジェクトを総当たりで見たいときは、.Keys でキー一覧を回す手もあります

Dim key As Variant
' 1人目のオブジェクトのキーと値を全部出す
For Each key In parsedData(1).Keys
    Debug.Print key & " = " & parsedData(1)(key)
Next key

ここまでで「読み込む(パース)」側はバッチリです、配列は番号・オブジェクトはキー名、これさえ押さえれば、たいていのJSONは取り出せます

ConvertToJson でVBAのデータをJSONに変換(生成)

今度は逆方向、つまりVBAのDictionaryやCollectionからJSON文字列を作る(生成する)パターンです、こちらは ConvertToJson 関数を使います

「VBAで作ったデータをAPIに送りたい」「JSON形式でファイルに保存したい」みたいなときに出番があります

Sub CreateJsonString()
    Dim postData As Object
    Dim skillsCollection As Collection
    Dim jsonString As String

    ' データを格納する親オブジェクトを準備
    Set postData = CreateObject("Scripting.Dictionary")

    ' 基本的なキーと値を追加
    postData("name") = "鈴木 一郎"
    postData("age") = 25

    ' 配列用のオブジェクトを「Collection」で準備
    Set skillsCollection = New Collection

    ' Collectionにデータを追加
    skillsCollection.Add "Word"
    skillsCollection.Add "PowerPoint"

    ' 親オブジェクトにCollectionを追加
    postData.Add "skills", skillsCollection

    ' DictionaryをJSON文字列に変換
    jsonString = ConvertToJson(postData)

    ' 結果をイミディエイトウィンドウに出力
    Debug.Print jsonString
    ' 想定される出力: {"name":"鈴木 一郎","age":25,"skills":["Word","PowerPoint"]}

    ' オブジェクトの解放
    Set postData = Nothing
    Set skillsCollection = Nothing
End Sub

ポイントは、JSONの「{ }」はDictionary、「[ ]」はCollectionで組み立てるという点です、パースのときと逆の対応関係になっているだけなので、慣れると自然に書けるようになります

この jsonString をWeb APIに送信(POSTなど)すれば、VBAで作ったデータをサーバーに送れます

改行付きで見やすく出力したいとき

デフォルトのままだと、生成されるJSONは改行なしの一行になります、人が読む用にきれいに整形したいときは、Whitespace オプションを付けます

' インデント2つ分で改行を入れて整形
jsonString = ConvertToJson(postData, Whitespace:=2)

ファイルに保存して中身を確認したいときなんかは、こちらのほうが見やすくておすすめです

VBA-JSONを使わずにJSONを扱う方法(JScript)

ここまでVBA-JSONをおすすめしてきましたが、「ライブラリを追加したくない」「配布先でインポートさせるのが面倒」というケースもありますよね

そういうときの代替案として、Windows標準のJScriptエンジンを使ってJSONをパースする方法もあるので紹介しておきます

JScriptはWindowsに最初から入っているスクリプト実行の仕組みで、これを ScriptControl という部品から呼び出すと、JavaScriptの JSON.parse をVBAから間接的に使えます

Sub ParseByJScript()
    Dim sc As Object
    Dim jsonText As String
    Dim parsed As Object

    jsonText = "{""name"":""Javeo"",""height"":180}"

    ' JScriptエンジンを用意
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"

    ' JavaScriptのJSON.parseで解析
    Set parsed = sc.Eval("(" & jsonText & ")")

    ' プロパティ名で値を取り出す
    Debug.Print parsed.name   ' → Javeo
    Debug.Print parsed.height ' → 180
End Sub

この方法のメリットは、外部ライブラリのインポートが要らないことです

ただ、いくつか弱点もあって、正直なところ常用にはVBA-JSONのほうが向いています

• ScriptControl は32bit版のOfficeでしか動かない(64bit版では別の書き方が必要)
• 取り出した値の扱い(配列やネスト)がVBA-JSONより少しクセがある
• Macでは使えない

なので個人的には、基本はVBA-JSON、どうしてもライブラリを足せない事情があるときだけJScriptという使い分けがおすすめです

VBA-JSONのよくあるつまずき・FAQ

VBA-JSONでハマりやすいポイントを、質問形式でまとめておきます、エラーが出たらまずここを確認してみてください

「ユーザー定義型は定義されていません」と出る

これは 参照設定の漏れがほぼ原因です

VBA-JSONはDictionaryを使うので、WindowsのExcelなら「ツール → 参照設定」で Microsoft Scripting Runtime にチェックが入っているか確認してください、入っていなければチェックを入れて保存し、もう一度実行すれば直ります

MacのExcelの場合は、前述のVBA-Dictionary(Dictionary.cls)を取り込んでいるかを確認しましょう

「KeyNotFoundError」のようなエラーが出る

これは、JSONに存在しないキー名を指定して取り出そうとしたときに出るエラーです

キー名のタイプミス、大文字小文字の違い、そもそもそのキーが無いJSONだった、あたりが定番の原因ですね

このエラーはハマりやすいので、原因の切り分けと対処法を VBA-JSONでKeyNotFoundErrorが発生するときの対処をまとめた記事 で別途くわしく解説しています、同じエラーで止まっている方はそちらをどうぞ

日本語が文字化けする

Web APIから取得したJSONの日本語が文字化けする場合は、文字コードの取り違えが原因のことが多いです

多くのAPIはUTF-8で返してくるので、responseText をそのまま使うとShift_JIS環境で化けることがあります、その場合は responseBody(バイト列)を取得して、UTF-8として読み直すと直ります

Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1               ' バイナリ
stream.Write http.responseBody
stream.Position = 0
stream.Type = 2               ' テキスト
stream.Charset = "UTF-8"       ' UTF-8として読み直す
jsonText = stream.ReadText
stream.Close

キーがあるか分からないとき、どう書けばいい？

キーが存在するか不安なときは、取り出す前に .Exists でチェックすると安全です(Dictionaryの機能です)

If parsedData(1).Exists("weight") Then
    Debug.Print parsedData(1)("weight")
Else
    Debug.Print "weightキーはありません"
End If

これを挟んでおくと、キーが無いJSONが来てもエラーで止まらずに処理を続けられます

VBA-JSONの活用例

導入と使い方が分かったところで、「で、実際どんなことに使えるの？」というイメージを少し具体的にしておきます

いちばん多いのは、やはり Web APIのレスポンス(JSON)をパースしてシートに展開するパターンです、為替レート・天気・在庫情報みたいな「外部の最新データ」をExcelに自動で取り込めると、手作業のコピペがまるごと無くなります

たとえばフリマやECのAPIを叩いて、出品データや売上をExcelに集計する、みたいな使い方ですね、APIへリクエストを送る具体的な書き方は eBay APIにVBAでリクエストを送る方法の記事 にまとめているので、JSONパースと組み合わせると一通りの流れがつかめます

逆に ConvertToJson 側だと、VBAで組み立てたデータをJSONにして、メール本文やAPIのリクエストボディに載せる、といった使い方ができます、VBAから自動でメールを送る仕組みは VBAでGmailを送信する方法の記事 で扱っているので、データ生成と通知を組み合わせたい方はあわせてどうぞ

そもそもVBA自体がはじめてで「Dim とか For Each の書き方からあやしい…」という方は、先に VBA入門の記事 で基礎をさらっておくと、この記事のコードもぐっと読みやすくなると思います

AIにVBA-JSONのコードを書いてもらうコツ

最近はClaudeやChatGPTにVBAコードを書いてもらう人も増えてきました、もちろんVBA-JSONを使ったコードも、頼めば書いてくれます

ただ、AIにそのまま「VBAでJSONをパースして」と頼むと、意図しない実装を返してくることがあるんですよね

• VBA-JSONを使わず、自前のJSON解析関数をゼロから書こうとする
• 参照設定の前提がズレていて、そのままだと動かないコードを返す
• 標準機能だけで無理やり読もうとして、やたら長いコードになる

こうしたズレを避けるには、依頼するときに次のような前提を明示するのがおすすめです

VBAで○○のJSONデータをパースするコードを書いてほしい
前提:
- VBA-JSON(JsonConverter.bas)を導入済み
- ParseJson の戻り値を Dictionary / Collection として直接扱う
- 参照設定は Microsoft Scripting Runtime を入れている前提
- 配列は番号、オブジェクトはキー名でアクセスする形で

エラーが出たときも、コードとエラーメッセージをまとめて貼り付ければ、AIが原因と対処をだいたい提示してくれます、自分でハマる時間がかなり減らせるので、これは活用しない手はないです

ClaudeでVBAコードを書いてもらう基本的な流れは Claudeの使い方を初心者向けに解説した記事 にまとめているので、AIにコードを頼むのが初めての方は、そちらから読むとスムーズだと思います

まとめ

VBA-JSONを使えば、これまでVBAでは扱いにくかったJSONが、ぐっと身近になります

導入のポイントはこの2つだけです

• JsonConverter.bas をVBEにインポートする
• Microsoft Scripting Runtime に参照設定する(Macは VBA-Dictionary)

使い方も、覚える関数は2つだけです

• JSONを読み込むなら ParseJson(配列は番号、オブジェクトはキー名で取り出す)
• JSONを書き出すなら ConvertToJson(「{ }」はDictionary、「[ ]」はCollectionで組む)

この導入2ステップと関数2つさえ押さえれば、Web APIとの連携をはじめ、VBAでできることの幅がかなり広がります

まずは手元の短いJSONを ParseJson に通して、Debug.Print で1個取り出してみるところから始めると、感覚がつかみやすいと思います

待機処理が必要な理由

SeleniumでWebサイトを操作するときにありがちな内容がこちら

• ページロードが完了していないうちに要素を取得してエラー
• JavaScriptで動的に生成されるボタンや入力欄がまだ非表示
• ボタンが表示されてもクリック可能になる前に操作しようとしてエラー

これらを解決するには「要素が存在する・表示される・有効になる」まで待機処理が必要です

WebDriverWaitクラスでできること

今回作ったVBAクラス WebDriverWait は、PythonのWebDriverWaitに近い操作性で以下の条件を待機できます

ポイント：

• 成功時は WebElement を返す
• タイムアウト時は Nothing を返す
• Pythonのように例外処理に頼らずVBAらしい安全な設計

VBA版WebDriverWaitの実装例

以下のクラスモジュールをVBAに追加してください※クラス名は WebDriverWait にしています

'--- クラス名: WebDriverWait ---
Option Explicit
'====================================================================================================
' PythonのWebDriverWaitの一部を再現したクラス
' ※条件に合致した場合はWebElementを返して一致しなかった場合はNothingを返す
'   - UntilPresenceeLocated・DOM上に指定したelementが表示されるまで待機は発生し得ないから準備していない
'   - UntilPresence・・・・・DOM上に指定したByが表示されるまで待機
'   - UntilVisibleLocated・・画面上に指定したelementが表示されるまで待機（IsDisplayed）
'   - UntilVisible ・・・・・画面上に指定したByが表示されるまで待機（IsDisplayed）
'   - UntilEnableLocated・・画面上に指定したelementが利用できるまで待機（IsDisplayed & IsEnabled）
'   - UntilEnable ・・・・・画面上に指定したByが利用できるまで待機（IsDisplayed & IsEnabled）
'====================================================================================================
Private pDriver As Selenium.WebDriver
Private pTimeout As Double
Private pInterval As Double

Public Sub Init(driver As Selenium.WebDriver, Optional timeoutSeconds As Double = 10, Optional intervalSeconds As Double = 0.5)
    Set pDriver = driver
    pTimeout = timeoutSeconds
    pInterval = intervalSeconds
End Sub

' Presence
Public Function UntilPresence(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            Set UntilPresence = elem
            Exit Function
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilPresence = Nothing
End Function

' Visibility (By指定)
Public Function UntilVisibleLocated(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            If elem.IsDisplayed Then
                Set UntilVisibleLocated = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilVisibleLocated = Nothing
End Function

' Visibility (element指定)
Public Function UntilVisible(elem As Selenium.WebElement) As Selenium.WebElement
    Dim start As Double: start = Timer
    
    Do
        If Not elem Is Nothing Then
            If elem.IsDisplayed Then
                Set UntilVisible = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilVisible = Nothing
End Function

' Enable (By指定)
Public Function UntilEnableLocated(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            If elem.IsDisplayed And elem.IsEnabled Then
                Set UntilEnableLocated = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilEnableLocated = Nothing
End Function

' Enable (element指定)
Public Function UntilEnable(elem As Selenium.WebElement) As Selenium.WebElement
    Dim start As Double: start = Timer
    
    Do
        If Not elem Is Nothing Then
            If elem.IsDisplayed And elem.IsEnabled Then
                Set UntilEnable = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilEnable = Nothing
End Function

使い方サンプル

このブログの練習用ページでテストできるようにしていますので自由にテストしてください

ポイントはInit部分で引数は下記の通りです

wait.Init driver, {最大待機秒数}, {判定間隔}

Sub test()
    Dim driver As New Selenium.ChromeDriver
    Dim By As New Selenium.By
    
    driver.Get "https://javeo.jp/practice_scraping/"

    Dim wait As New WebDriverWait
    wait.Init driver, 10, 0.5

    ' presence_of_element_located(By)
    Dim elemUser As Selenium.WebElement
    Set elemUser = wait.UntilPresence(By.Css("#input_test"))
    

    ' visibility_of_element_located(By)
    Dim elemPass As Selenium.WebElement
    Set elemPass = wait.UntilVisibleLocated(By.Css("#textarea_test"))

    ' element_to_be_clickable(By)
    Dim elemBtn As Selenium.WebElement
    Set elemBtn = wait.UntilClickableLocated(By.Css("[name=""checkbox_test""]"))

    
    elemUser.SendKeys "testuser"
    elemPass.SendKeys "secret"
    elemBtn.Click
End Sub

まとめ

個人的にPythonでもSeleniumを使うのでWebDriverWaitが使えない不便さを感じていました

PythonとVBAでは思想も違うので適当にいじってますが、ほぼ同じように使えてスッキリです！

やっていること

1. chromedriverの保存先は端末環境によって違うので候補となる3箇所のフォルダ有無を確認
2. chromeの保存先も端末環境によって違うので候補となる3箇所のフォルダ有無を確認
3. PowerShellでchromeのバージョンを取得する
   ※なので一瞬PowerShellの画面がチラつきます
4. APIでChrome.exeのビルドまで一致している最新chromedriverのダウンロードパスを取得
5. ダウンロードしたzipファイルを解凍してをseleniumbasic用のフォルダへコピーする

以前作成したVBAはJSON API endpointsを総当たりで取得していたのでJSONをパースする必要がありましたが、APIでドライバのバージョンを直接取得できることに気づいて少し手順を簡略化できました

処理としては数秒しか変わりませんがVBA-JSOＮ不要になったのは個人的にGoodポイント

ここからは以前と同じことを書いてますが単独でこのページを見ていただいた方向けです

必要な参照設定

このプログラムを実行するために設定した参照設定

追加したのは下記3つ

• Microsoft Scripting Runtime
• Microsoft XML, v6.0
• Selenium Type Library

ここは旧バージョンと変わりありません

ファイルへの反映手順

サンプルファイルとソースは下部に準備していますがファイルへの反映方法がわからない方向けに反映と使い方です

そんなことわかってるからはよソースを！って方は下部のソースまで飛んじゃってください

プロパティウィンドウを表示しておく

あとからモジュール名を変更したいので、もし表示されていない時は表示しておく

標準モジュールを追加

自動更新プログラム用にモジュールを追加する

モジュール名を変更する

必須ではないんですが、わかりやすい運用のためにはモジュール名変更推奨です

今回は”ChromeDriverAutoUpdateModule“にします

プログラムの使い方

「<モジュール名>.<プロシージャ名>() ※”<モジュール名>.”は省略可」でプログラムを呼び出せるので、本体プログラムの最初に「ChromeDriverAutoUpdateModule.ChromeDriverAutoUpdate()」を追加すれば必要なときにchromedriverが自動更新されます

Sub main()
'---Chromedriverの自動更新 ※別モジュールを参照
If ChromeDriverAutoUpdateModule.ChromeDriverAutoUpdate Then
    Exit Sub
End If

'－－・－－・－－以下にプログラムを－－・－－・－－
End Sub

Chromedriverの書き込み権限がない時

Winsows11からセキュリティ周りが厳しくなったのか管理者権限でSeleniumBasicをインストールした場合、Chromedriverを更新しようとすると書き込み権限なしエラーが発生するので対応まとめました

画像の通りですが下記手順で権限設定ができます

1. “C:\Program Files”にある”SeleniumBasic”フォルダを右クリック
2. 右クリックメニューで”プロパティ”をクリック
3. セキュリティタブに移って”編集”ボタンをクリック
4. “Users（{コンピュータ名}\Users）”をクリック
5. “フルコントロール”にチェックがついていないはずなのでクリックしてチェックを付ける
6. “適用”ボタンをクリック

サンプルファイル

JSON-VBA含めて最低限のモジュールをセットしたファイル準備したので一から作る時のベースにしていただければ

最後に実際のソース

まずはGithubをご利用の方向けはこちら

https://github.com/javeo2022/webdriver_manager_VBA_Lite

例によってコピペ用はこちらです

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long
Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHCreateDirectoryExA" _
                        (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As LongPtr) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long
Private Declare Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHCreateDirectoryExA" _
                        (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As LongPtr) As Long
#End If

Private Type VersionType '---本当はクラスオブジェクトにしたいけどこれだけのためにモジュール作りたくない
    Major As Long
    Minor As Long
    Build As Long
    Revision As Long
    BuildVersion As String
    RevisionVersion As String
End Type
Const ZIP_FILE As String = "chromedriver.zip"
Const DRIVER_EXE As String = "chromedriver.exe"
Dim workPath As String
Sub test()
Call ChromeDriverAutoUpdate
End Sub
Public Function ChromeDriverAutoUpdate(Optional ByVal ForcedExecution As Boolean = False) As Boolean
'====================================================================================================
'chrome.exeとchromedriver.exeのバージョンを比較してchromedriverを自動更新する
'もしくは強制実行フラグ（ForcedExecution）がTrueでも実行する
'====================================================================================================
    Dim chromePath As String '---chrome.exeが保存されているパス
    Dim chromeFullpath As String '---chrome.exeまで含めたフルパス
    Dim chromeVersion As VersionType
    Dim chromedriverPath As String
    Dim chromedriverFullPath As String
    Dim objFso As New Scripting.FileSystemObject
    ' ---chromedriverをダウンロード用のフォルダを作成する　※Seleniumのキャッシュ構造に合わせている
    workPath = Environ("USERPROFILE") & "\.cache\selenium\seleniumbasic"
    Select Case SHCreateDirectoryEx(0&, workPath, 0&)
        Case 0:
            ' ---作成成功
        Case 183
            ' ---作成済み
        Case Else:
            ' ---作成できなかった時
            MsgBox "ダウンロード用フォルダを作成できませんでした" & vbCrLf & Error(Err), vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---chrome本体のフォルダを探す
    Select Case True
        Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\Google\Chrome\Application")
            chromePath = Environ("LOCALAPPDATA") & "\Google\Chrome\Application"
        Case objFso.FolderExists(Environ("ProgramW6432") & "\Google\Chrome\Application")
            chromePath = Environ("ProgramW6432") & "\Google\Chrome\Application"
        Case objFso.FolderExists(Environ("ProgramFiles") & "\Google\Chrome\Application")
            chromePath = Environ("ProgramFiles") & "\Google\Chrome\Application"
        Case Else
            MsgBox "'chrome'フォルダが見つかりません", vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---念のためchrome.exeを確認する
    If objFso.FileExists(chromePath & "\chrome.exe") = True Then
        chromeFullpath = chromePath & "\chrome.exe"
    Else
        MsgBox "'chrome.exe'が見つかりません", vbCritical
        Exit Function
    End If
    
    '---SeleniumBasicのフォルダを探す
    Select Case True
        Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\SeleniumBasic")
            chromedriverPath = Environ("LOCALAPPDATA") & "\SeleniumBasic"
        Case objFso.FolderExists(Environ("ProgramW6432") & "\SeleniumBasic")
            chromedriverPath = Environ("ProgramW6432") & "\SeleniumBasic"
        Case objFso.FolderExists(Environ("ProgramFiles") & "\SeleniumBasic")
            chromedriverPath = Environ("ProgramFiles") & "\SeleniumBasic"
        Case Else
            MsgBox "'SeleniumBasic'のフォルダが見つかりません", vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---念のためchromedriver.exeを確認する
    If objFso.FileExists(chromedriverPath & "\" & DRIVER_EXE) = False Then
        Debug.Print "'chromedriver.exe'が見つかりませんでした"
    End If
    chromedriverFullPath = chromedriverPath & "\" & DRIVER_EXE
        
    '---chrome.exeのバージョンを取得する
    If GetChromeVersion(chromeFullpath, chromeVersion) = False Then '---chrome.exeのバージョンを取得する
        MsgBox "'chrome.exe'のバージョンが取得できませんでした", vbCritical
        ChromeDriverAutoUpdate = False
        Exit Function
    End If
    
    '---chrome.exeのバージョンに合わせたchromedriver.exeをダウンロードする
    If ChromedriverQuickCheck(chromedriverPath, chromeVersion) = False Then '---chromedriverのバージョンを取得する
        MsgBox "'chromedriver.exe'のバージョンが取得できませんでした", vbCritical
        ChromeDriverAutoUpdate = False
        Exit Function
    End If
    
    '---結果として更新していない場合もあるが、更新失敗じゃなくて更新不要な判定だからTrueを返す
    ChromeDriverAutoUpdate = True
Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chromedriver の入替に失敗しました" & vbCrLf & Error(Err) & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    ChromeDriverAutoUpdate = False
End Function
Private Function GetChromeVersion(ByVal chromeFullpath As String, ByRef chromeVersion As VersionType) As Boolean
'====================================================================================================
'PowerShellでchrome.exeのバージョン情報を取得する　※一瞬PowerShellが立ち上がる
'====================================================================================================
    Dim command As String
    Dim objRet As Object
    
    On Error GoTo ErrLabel
        '---chromeバージョン情報の初期値
        chromeVersion.Major = 1
        chromeVersion.Minor = 0
        chromeVersion.Build = 0
        chromeVersion.Revision = 0
        '---chrome.exeのバージョンを取得するPowerShellコマンド
        command = "powershell.exe -NoProfile -ExecutionPolicy Bypass (Get-Item -Path '" & chromeFullpath & "').VersionInfo.FileVersion"
        '---PowerShellの実行結果をセット
        Set objRet = CreateObject("WScript.Shell").Exec(command)
        '---PowerShellのコマンドレットの実行結果を取得
        chromeVersion.RevisionVersion = Trim(objRet.StdOut.ReadAll)
        '---情報の取得が終わったらオブジェクトをクリアする
        Set objRet = Nothing
        '---改行コードが含まれているから削除する
        chromeVersion.RevisionVersion = Trim(Replace(Replace(Replace(chromeVersion.RevisionVersion, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString))
        '---バージョン情報を分けて返す
        With CreateObject("VBScript.RegExp") '---正規表現の準備
            .Pattern = "\d+\.\d+\.\d+(\.\d+)?"
            .Global = True
            If .test(chromeVersion.RevisionVersion) Then '---念のため正規表現でバージョン情報をチェックする
                chromeVersion.Major = CLng(Split(chromeVersion.RevisionVersion, ".")(0))
                chromeVersion.Minor = CLng(Split(chromeVersion.RevisionVersion, ".")(1))
                chromeVersion.Build = CLng(Split(chromeVersion.RevisionVersion, ".")(2))
                If UBound(Split(chromeVersion.RevisionVersion, ".")) >= 3 Then '---リビジョン番号がなければ9999を仮でセット※基本あるはず
                    chromeVersion.Revision = CLng(Split(chromeVersion.RevisionVersion, ".")(3))
                Else
                    chromeVersion.Revision = 9999
                End If
                chromeVersion.BuildVersion = Join(Array(chromeVersion.Major, chromeVersion.Minor, chromeVersion.Build), ".") '---リビジョンを覗いたショートバージョン情報をセットする
                Debug.Print "Chromeのバージョン：" & chromeVersion.RevisionVersion
            Else '---正規表現不一致なら失敗で返す
                MsgBox "chrome.exe のバージョン情報取得に失敗しました" & vbCrLf & "[取得バージョン情報：" & chromeVersion.RevisionVersion & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
                GetChromeVersion = False
                Exit Function
            End If
        End With
        GetChromeVersion = True
    On Error GoTo 0
    Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chrome.exe のバージョン情報取得に失敗しました" & vbCrLf & "[" & Error(Err) & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    GetChromeVersion = False
End Function
Private Function ChromedriverQuickCheck(chromedriverPath, chromeVersion As VersionType) As Boolean
    Dim objHttp As New MSXML2.XMLHTTP60
    Dim targetVarsion As String
    Dim uri As String
    Dim api_endpoints As String
    Dim downloadPath As String
    Dim objFso As New Scripting.FileSystemObject
    Const TARGET_PLATFORM As String = "win64"

    api_endpoints = "https://googlechromelabs.github.io/chrome-for-testing/LATEST_RELEASE_" & chromeVersion.BuildVersion
    On Error GoTo ErrLabel
        With objHttp
            .Open "GET", api_endpoints, False
            .Send
            targetVarsion = .responseText '---JSON endpoints から情報を収集する
            downloadPath = workPath & "\" & targetVarsion
            '--- 念のためリビジョンバージョンを比較する
            If chromeVersion.Major >= CLng(Split(targetVarsion, ".")(0)) Then
                '--- まだダウンロードしていなかったらダウンロードする
                If objFso.FileExists(downloadPath & "\" & DRIVER_EXE) = False Then
                    uri = "https://storage.googleapis.com/chrome-for-testing-public/" & targetVarsion & "/" & TARGET_PLATFORM & "/chromedriver-" & TARGET_PLATFORM & ".zip"
                    Call DownloadChromedriver(uri, targetVarsion)
                    Call objFso.DeleteFile(chromedriverPath & "\" & DRIVER_EXE, True)
                    Debug.Print "インストールしたChromedriverのバージョン：" & targetVarsion
                End If
                '--- chromedriverはいつでも上書きする
                Call objFso.GetFile(downloadPath & "\" & DRIVER_EXE).Copy(chromedriverPath & "\" & DRIVER_EXE, True)
            Else
                Debug.Print "Chromeのバージョンが古いためChromedriverは更新しません"
            End If
        End With
    On Error GoTo 0
    ChromedriverQuickCheck = True
    Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chromedriver.exe の更新に失敗しました" & vbCrLf & "[" & Error(Err) & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    ChromedriverQuickCheck = False
End Function
Private Function DownloadChromedriver(ByVal url As String, targetVersion As String) As Boolean
    Dim rc As Long
    Dim downloadPath As String
    Dim newDriverPath As String
    Dim objFso As New Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    downloadPath = workPath & "\" & targetVersion
    ' ---chromedriverのフォルダを作成する
    Select Case SHCreateDirectoryEx(0&, downloadPath, 0&)
        Case 0:
            ' ---作成成功
        Case 183
            ' ---作成済み
        Case Else:
            ' ---作成できなかった時
            MsgBox "ChromeDriver用フォルダを作成できませんでした" & vbCrLf & Error(Err), vbCritical
            DownloadChromedriver = False
            Exit Function
    End Select
    
    '---ファイルをダウンロードする
    If URLDownloadToFile(0, url, workPath & "\" & ZIP_FILE, 0, 0) <> 0 Then
        MsgBox "ChromeDriverをダウンロードできませんでした" & vbCrLf & Error(Err), vbCritical
        DownloadChromedriver = False
        Exit Function
    End If
    Application.DisplayAlerts = False
    '---zipを既定のフォルダに向けて解凍する
    With CreateObject("Shell.Application") '---zipを既定のフォルダに向けて解凍する
        .Namespace((downloadPath)).CopyHere .Namespace((workPath & "\" & ZIP_FILE)).Items
    End With
    '--- 解凍したフォルダから再起処理してchromedriver.exeのフルパスを取得する
    newDriverPath = SearchFilesRecursively(downloadPath & "\", "chromedriver.exe")
    If newDriverPath = "" Then
        MsgBox "chromedriver.exe の更新に失敗しました"
        DownloadChromedriver = False
    End If
    '---chromedriverをバージョンフォルダ直下に移動する
    Call objFso.MoveFile(newDriverPath, downloadPath & "\")
    '---chromedriverがなくなった不要フォルダを削除する
    For Each objFolder In objFso.GetFolder(downloadPath).SubFolders
        objFolder.Delete True
    Next
    '---zipファイルを削除する
    Call objFso.DeleteFile(workPath & "\" & ZIP_FILE, True)
    Application.DisplayAlerts = True
    DownloadChromedriver = True
End Function
Function SearchFilesRecursively(ByVal folderPath As String, fileName As String) As String
    '====================================================================================================
    ' folderPathを起点に再帰処理でサブフォルダまで対象にしてfileNameを探してフルパスを返す
    '====================================================================================================
    Dim objFso As New Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    Dim subFolder As Scripting.Folder
    Dim objFile As Scripting.File
    Dim result As String

    ' ファイル一覧をチェック
    For Each objFile In objFso.GetFolder(folderPath).Files
        If objFile.Name = fileName Then
            SearchFilesRecursively = objFile.Path
            Exit Function
        End If
    Next objFile

    ' サブフォルダを再帰的に探索
    For Each subFolder In objFso.GetFolder(folderPath).SubFolders
        result = SearchFilesRecursively(subFolder.Path, fileName)
        If result <> "" Then
            SearchFilesRecursively = result
            Exit Function
        End If
    Next subFolder

    ' 見つからなかった場合
    SearchFilesRecursively = ""
End Function

あとがき

こちらが後出しなので簡易版としましたがむしろこちらを正規版で過去作成した方を特殊版にした方がいいかなと思っているレベル

今後改修するとしたらこちらになる予定です

変数

変数とは

変数が何かというとその名の通り”中身が変わる数（値）”のことを指します

計算結果や文字列、オブジェクトなどを一時的に格納して利用しますがExcel作業に例えると、セルに値を入力して必要なときに参照するイメージに近いです

変数を使う目的

変数を使う一番の目的は、”プログラムの中で扱う値を一時的に記憶し、再利用できるようにすること“です

もし変数を使わずに直接セルや数値を書き込むだけだと、同じ処理を繰り返すときに毎回手直しが必要になり、コードの柔軟性が失われます

変数を使うことで以下のメリットがあります

• 処理の効率化：一度計算した値を保存し、繰り返し利用できる
• 保守性の向上：変更が必要な場合、変数の値を変えるだけで済む
• 可読性の向上：意味のある名前をつけることで、コードを読んだ人が目的を理解しやすい
• 一時的なデータ保持：途中計算の結果やフラグ（条件判定用のTrue/Falseなど）を保持する

変数の書き方

VBAで変数を宣言する場合の基本形は”Dim 変数名 As データ型“です

Dim score As Integer
Dim name As String

• Dim … 変数を宣言するためのキーワード
• 変数名 … 値を格納する箱の名前　※後述の命名規則を要確認
• データ型 … その変数にどの種類のデータを入れるか指定

変数の命名規則

VBAは柔軟なプログラムなので実は日本語を変数名にすることもできます・・・が、一般的には英語で書きますし他の言語では受け入れられないのがほぼなのでまずは英語で書きましょう

そしてVBAで多く使われるのはキャメルケースでハンガリアン記法の利用もボチボチ

他がNGってわけでもないですが一般的な記述にすることで可読性と保守性が上がるのでなるべく合わせましょう

Dim targetRow As Long   ' ---キャメルケース
Dim lngRow As Long      ' ---ハンガリアン記法
Dim target_row As Long  ' ---スネークケース 
Dim TargetRow As Long   ' ---パスカルケース
Dim 対象行 As Long       ' ---日本語は非推奨

変数のスコープ

変数にはスコープと言われる考え方がありまして、Dimの代わりに”Private/Public“で宣言することで使える範囲が変わります

範囲の考え方はおおきくわけて2つ

• 同一プロジェクト内（≒Excelファイル）でモジュールを跨いで利用することができるか・・・①②
• 同一モジュール内でプロシージャを跨いで利用できるか・・・③④

宣言する場所による違い（プロシージャ内外）

プロシージャ外で宣言すると同一モジュール内の全プロシージャで変数が利用できるようになり、変数の値はプロシージャを跨いでも保持されます

プロシージャ内で宣言すると同一プロシージャの中だけで利用できるようになります

プロシージャ外で宣言する場合のPrivete/Publicステートメント

プロシージャ外で宣言する場合はDimの代わりにPrivateとPublicも利用できます

修飾子	スコープ	他モジュールからアクセス
Private	モジュール内限定	不可
Public	プロジェクト全体	可能

データ型について

変数は”文字”や”数字”などデータの型を指定することができます

指定しないことも可能ですが、プログラムでは数字の100（ひゃく）と文字の100（いちぜろぜろ）は違うのでエラー・バグの温床になってしまうため原則指定します

基本的なデータ型

まずは基本になる様々な”値“を取り扱う時に指定するデータ型から

Integerは使われるところをよく見かけますが、Longが上位互換みたいなものなので使う必要が無いって意味で使用頻度は”低”にしています

オブジェクト型について

基本形と違って”値”ではなくデータの箱のようなものを格納するオブジェクト型がありまして、このオブジェクト型は何か一つのことを指すわけではなく”Workbook（ブック）“、”Worksheet（シート）“、”Range（セル）“などをまとめてオブジェクト型と呼びます

種類は無数にあるのでここでは触れませんが、VBAを利用していれば嫌でも出会うので細かい話はサンプルプログラムの説明などで

ちなみにオブジェクト型に代入するときはSetステートメントが必要なので利用時にはご注意を

Dim name As String
Dim wb As Workbook

name = 'ジャベ雄'
Set wb = Thisworkbook ' ---オブジェクトへの代入はSetから始める

なるべく使用を控えたいけど便利な万能データ型

データ型の冒頭で触れたデータ型を”指定しない”時に関連しますが、データ型の一つに万能型の”Variant“がありまして、指定しない場合はこの万能型が適用されます

もう一つオブジェクト型なら何でも入る”Object“があります

ObjectはVariantでも代用できないわけではないですが、なるべくデータ型は指定する思想があるので最低限使い分けはしたいところ

Variant型（データ型を指定しない）はなるべく避けたいとことですが、Arrayなど一部Variantでしか取り扱えない場合や、プログラムの中でどのデータ型になるかわからない場合があるので状況に応じて利用しましょう

列挙型（Enum）とユーザー定義データ型（Type）

イレギュラー枠でEnumとTypeがありまして、EnumはLongの集合体、Typeは変数を束ねると考えるとしっくりきます

これも奥が深いのでここでは紹介だけまでにして、サンプルソース置くのでこんなのもあるんだーぐらいでどうぞ

Enum WeekDay
    Sunday      ' 0
    Monday      ' 1
    Tuesday     ' 2
    Wednesday   ' 3
    Thursday    ' 4
    Friday      ' 5
    Saturday    ' 6
End Enum

Sub ShowDay()
    MsgBox "今日の曜日は: " & WeekDay.Monday  ' 結果は「1」
End Sub

Type Employee
    Name As String
    Age As Integer
    Salary As Double
End Type

Sub ShowEmployee()
    Dim emp As Employee
    emp.Name = "田中 太郎"
    emp.Age = 30
    emp.Salary = 5000000

    MsgBox "氏名: " & emp.Name & vbCrLf & _
           "年齢: " & emp.Age & vbCrLf & _
           "給与: " & emp.Salary & "円"
End Sub

定数

定数とは

定数は”中身を定めたわる数（値）”のことを指します

基本的な使い方は変数と同じですが違いがあるところだけピックアップします

定数を使う目的

定数の目的は、決して変わらない値をプログラム中で安全に使うことです

例えば消費税率や基準日などをいつか一括で修正する可能性がある値は、後から修正するときに見落としやすく、バグの原因になります

その他にも定数を使うことで以下のメリットがあります

• 安全性の確保：プログラム実行中に誤って値を書き換えられる心配がない
• 変更管理が容易：消費税率などを1か所変更すればプログラム全体に反映できる
• 可読性の向上：「0.1」より「TAX_RATE」のような名前を使うことで意味が明確になる
• 保守性の向上：長期的に見ても管理がしやすく、他人がコードを読んだときも理解しやすい

定数の書き方

VBAで定数を宣言する場合の基本形は”Const 変数名 As データ型 = 値“です

Const score As Integer = 100
Const name As String = "ジャベ雄"

変数と違って宣言と同時に値を決めてその後編集不可になります

定数の命名規則

変数と同じように一般的に使われる命名規則がありまして、全て大文字のスネークケースで一見して意味が分かる単語を結合します

Const MAX_USER_COUNT As Integer = 100
Const DEFAULT_FONT_SIZE As Double = 12.5
Const API_ENDPOINT_URL As String = "https://example.com/api"

まとめ

結構初歩の部分ですがまとめ始めるとなかなかのボリュームになってしまいました

良くも悪くもシステムとしての制限がないので自分でやチームでルールを作って安定運用できるプログラム作成を心がけましょう！

[temp id=2]

VBAを始める前に

VBAを始める前にまずVBAの概要とExcelの準備です

VBAとは

VBA（Visual Basic for Applications）は、Microsoft 365・Office製品（Excel、Accessなど）で使用できるプログラミング言語です

よくVBAとマクロの違いみたいな話を見ますがマクロは機能名でVBAはその中身って感じで会話の中では同じものとして扱って大丈夫かなと

VBAを使いこなせば、これまで何時間もかかっていた作業がボタン一つで一瞬で終わる、なんてことも夢ではありません

開発者タブを表示しよう

ExcelでVBA始めるならまず開発タブを表示しましょう

正直慣れるとVBEの画面は”Alt+F11“で開くしマクロは”Alt+F8“で実行しちゃうので使う頻度は減りますが最初はあったほうが便利です

VBAで押さえておきたい基本

VBAを学ぶ上で、最低限知っておきたい基本的な概念をいくつか紹介します

最初は難しく感じるかもしれませんが、深堀は別でやりますので今は「こういうものがあるんだな」くらいの気持ちで読み進めてください

変数と定数

プログラミングでは、データ（数値や文字列など）を一時的に保存しておくための「箱」のようなものを使いますが、この箱のことを変数や定数と呼びます

Sub test()
Const tax_rate As Double = 0.1 '---税率
Dim price_excluding_tax As Long '---税抜き価格
Dim price_including_tax As Long '---税込み価格

price_excluding_tax = 1980
price_including_tax = price_excluding_tax * (1 + tax_rate)
Debug.Print (price_including_tax)
End Sub

データ型

変数や定数には、どんな種類のデータを入れるかをあらかじめ決めておく必要があり、これをデータ型と呼びます

例えば、数値を扱うのか、文字を扱うのか、日付を扱うのか、といった区別です

条件分岐、ループ処理などのフロー制御

プログラムは基本的に上から下へ順番に実行されますが、フロー制御を使うことで状況に応じて処理の流れを変えることができます

' A1～A10のセルの中で300以上の数字だったら文字を赤くする
Sub test()
Dim i As Long
For i = 1 To 10
    If Cells(i, 1).Value >= 300 Then
        Cells(i, 1).Font.Color = RGB(255, 0, 0)
    End If
Next
End Sub

メインプロシージャとサブプロシージャ

VBAでは、一連の処理のまとまりをプロシージャと呼びます

機能や仕組みではなく、役割や考え方みたいな位置づけなので必ずしもこの二つが必要ってわけではなく簡単なプログラムならプロシージャー1つなんてことも多々ありますし、サブプロシージャーのさらにサブプロシージャーを作ったりすることもあります

車でいうとメインプロシージャが車の組み立て、サブプロシージャーが各部品の作成のイメージですね

Sub MainProcedure()
    Debug.Print ("これがメインプロシージャーです")
    Call SubProcedure1
    Call SubProcedure2
End Sub
Sub SubProcedure1()
    Debug.Print ("これがメインプロシージャー1です")
End Sub
Sub SubProcedure2()
    Debug.Print ("これがメインプロシージャー2です")
End Sub

可読性の重要性

VBAは自分だけでなく、他の人がコードを読む（または将来の自分が見返す）可能性もあります

誰が見ても分かりやすい、可読性の高いコードを書くことは非常に重要です

インデントについて

インデントとは、行頭の字下げのことで処理の塊（ブロック）を視覚的に分かりやすくするために行います

If文やFor文などフロー制御の中の処理は、インデントを下げるのが一般的です

' 悪い例
If Range("A1").Value > 10 Then
MsgBox "10より大きいです"
End If

' 良い例
If Range("A1").Value > 10 Then
    MsgBox "10より大きいです"
End If

変数などの命名規則について

変数やプロシージャの名前は、その役割がひと目で分かるように付けることが大切です

例えば、”a"や”b"のような無意味な名前ではなく、"userName"（ユーザー名）や"calculateTotalPrice"（合計金額を計算する）のように一見して意味が分かるようにすることが望ましいです

書き方にも規則性がありまして”定数は全て大文字にする”、”プレフィックスでデータ型を示す”、”単語を特定の文字で繋ぐ”などなど言語や時代によって変化はありますが少なくとも一つのプログラムの中では一貫したルールにすべきです

モジュールの種類

VBAのコードを記述する場所をモジュールと呼びます

モジュールにはいくつか種類がありますが、初心者がまず覚えておくべきなのは以下の2つです

まとめ

今回は、VBAの魅力とその基本的な概念についてお話ししました。最初は覚えることが多くて大変に感じるかもしれませんが、一つ一つは決して難しいものではありません。

VBAを学ぶ最大のメリットは、日々の業務に直結するスキルであるということです。学習したことがすぐに実践で活かせ、成果が目に見えやすいので、モチベーションを維持しやすいのも特徴です。

このブログでは、今後もVBAの具体的な書き方や便利なテクニックをどんどん紹介していきます。ぜひ、次回の記事もチェックして、退屈な繰り返し作業から解放され、より創造的な仕事に時間を使えるようになりましょう！

[temp id=2]

再帰処理とは

一言で表すと関数やプロシージャが自分自身を呼び出す処理のこと

処理方法の話なので当然VBAだけでなく他のプログラム言語でも使われる処理ですが、私が一番しっくりきたパソコンのフォルダ潜りながらフォルダ情報を収集するプログラムを例に解説します

サンプルプログラム

メチャメチャシンプルなサンプルプログラムです

何をやっているかと言うとファイルが保存されているフォルダを起点にサブフォルダを照会して、今度はそのフォルダを起点にしてサブフォルダを照会して・・・を繰り返します

Sub AddFolderList()
'------------------------------
' メインプロシージャ
'------------------------------
Dim objFso As New Scripting.FileSystemObject

Debug.Print "RootFolder：" & ThisWorkbook.Path
Call SearchFolder(objFso.GetFolder(ThisWorkbook.Path), 1)
End Sub
'------------------------------------------------------------------------------------------
Function SearchFolder(TargetFolder As Scripting.Folder, FolderLv As Long)
'------------------------------
' 再帰処理用プロシージャ
'------------------------------
Dim objFld As Scripting.Folder

Call GetFolderInfo(TargetFolder, FolderLv)
For Each objFld In TargetFolder.SubFolders
    Call SearchFolder(objFld, FolderLv + 1)
Next
End Function
'------------------------------------------------------------------------------------------
Function GetFolderInfo(TargetFolder As Scripting.Folder, FolderLv As Long)
'------------------------------
' フォルダ情報をイミディエイトに表示
'------------------------------
Debug.Print String(FolderLv, "　") & "FolderName：" & TargetFolder.Name
Debug.Print String(FolderLv + 2, "　") & "├FileCount：" & TargetFolder.Files.Count
Debug.Print String(FolderLv + 2, "　") & "├TotalSize：" & TargetFolder.Files.Count
Debug.Print String(FolderLv + 2, "　") & "├CreateDate：" & TargetFolder.DateCreated
Debug.Print String(FolderLv + 2, "　") & "└UpdateDate：" & TargetFolder.DateLastModified
End Function

再帰処理のイメージ

まず再帰処理を使わずに再現しようとした時のプログラムがこちら

フォルダ1-Aを起点とするとその中にフォルダ2-A/2-Bがある、2-Aの中にフォルダ3-Aがあってさらにその中にフォルダ4-A/4-B/4-Cがある

事前に構造がわかっていれば↓の別サンプルのようにFor Nextを必要回数入れ子にして対応することもできますが例えば4-Aの中に新しいフォルダが作成された時、階層がもう一段階深くなるので入れ子が足りず取得できません

無理矢理運用するなら10回くらい入れ子にしておけば大体大丈夫ですがそれではイマイチ

Function SearchFolder(main As Scripting.Folder)
'------------------------------
' 再帰処理しない時のプログラム例
'------------------------------
Dim sub1 As Scripting.Folder, sub2 As Scripting.Folder, sub3 As Scripting.Folder

Call GetFolderInfo(main, 1)
For Each sub1 In TargetFolder.SubFolders
    Call SearchFolder(sub1, 2)
    For Each sub2 In sub1.SubFolders
        Call SearchFolder(sub2, 3)
        For Each sub3 In sub2.SubFolders
            Call SearchFolder(sub3, 4)
        Next
    Next
Next
End Function

そしてこちらが再帰処理のイメージ

Mainフォルダに1-Aを代入すると2-A/2-BがSubフォルダとして取得できる

Subフォルダ2-AをMainフォルダに代入すると次は3-AがSubフォルダに、続いて3-AをMainフォルダにすると4-A/4-B/4-CがSubフォルダになる

ポイントはここでさらに下の階層があればループが続くし、なければここで処理が終わるところ

プログラムも短くスッキリした感じになります

再帰処理のメリット・デメリット

結局のところ再帰処理って必要な処理なの？メリット・デメリットは？ってことでまとめてみます

メリット

繰り返すべき回数が可変なプログラムでも対応することができます

今回のフォルダであれば起点から3階層潜ったわけですが当然もっと深い階層がある可能性もありますがサブフォルダがあればループする仕様になるのでプログラムとして最適化できます

デメリット

再帰処理は処理の途中で別のことに手を付けるようなことなのでループする度メモリを使うことになり、やり過ぎはメモリ不足を招く可能性があります

もう一点はデメリットと言うより注意点になりますが、処理方法については無限ループになってしまいます

例えばこんな処理

'==============================
' 無限ループになるプログラム
'==============================
Sub sample()
Dim i As Long

i = 1
Call AdditionFunc(i)
End Sub
'-------------------------------
Function AdditionFunc(i As Long)
Debug.Print i
Call AdditionFunc(i + 1)
End Function

加算し続けるだけで終わりのない無限処理になってしまうのでループに条件を付けるもしくはループを抜ける分岐を付けてあげる必要があります

'==============================
' 無限ループを回避したプログラム
'==============================
Sub sample()
Dim i As Long

i = 1
Call AdditionFunc(i)
End Sub
'------------------------------
Function AdditionFunc(i As Long)
Debug.Print i
'---10未満の時だけ再帰処理する
If i < 10 Then
    AdditionFunc = AdditionFunc(i + 1)
End If
End Function

あとがき

再帰処理をフォルダ検索を例に解説してみました

わかるようでわからない再帰処理も実例があるとしっくりきませんか？私はきましたw

他の言語でも考え方や書き方は同じなので参考にしてみてください

ツールの仕様

VBAのことはいいからツールを使ってみたい！って方向けにまずはツールの仕様から

設定項目

絵が合った方が早いのでまずはエクセルの切り抜きから

対象フォルダ指定（グレー背景箇所）

まずは取得対象とするフォルダの指定

サブフォルダも取得するようにすると対象フォルダ以下全てのフォルダが取得対象に

ちなみにフォルダ名のところでダブルクリックするとダイアログで対象フォルダを選べる仕様にしています

フォルダ名の指定（青背景箇所）

次はフォルダ名の指定

各項目の入力条件で取得対象を制限できます

パイプ文字は”|”のことでキーボードで言うと右上の”\”をshift押しながら押下で入力できます

ファイル名の指定（緑背景箇所）

ファイル名の指定もフォルダと同じ方法

このファイル名に拡張子は含まないので注意

拡張子の指定（オレンジ背景箇所）

フォルダ名、ファイル名の指定と同じ

.（ドット）はいらないのでエクセルなら”xlsx”でOK

プログラムについて

ここからVBAの説明に移ります

コピペでそのまま使えるプログラムと各プロシージャの説明を

必要な参照設定

フォルダ・ファイルの情報を扱うので必須レベルな”FileSystemObject“を使用しますから”Microsoft Scripting Runtime“の参照をどうぞ

その他はありませんので魔改造する時に必要に応じて

コピペ用 プログラムの全貌

説明なんぞ不要でファイルがあればいい、プログラムがあればいいって方向けに最初にVBAの全プログラムとそのまま使えるマクロファイルです

長ったらしいので畳んでますが見たい方は広げてください

Option Explicit
Enum lngCol
    file_name = 1
    ext_name
    file_size
    create_date
    mod_date
    file_path
    file_path_split
End Enum
Dim objFso As New Scripting.FileSystemObject
Sub GetFileList()
Dim ws As Worksheet
Dim target_folder As String

'---起点フォルダの確認
target_folder = Trim(Range("TARGET_FOLDER").Value)
If objFso.FolderExists(target_folder) = False Then
    MsgBox "対象フォルダが見つかりません", vbCritical
    Exit Sub
End If

'---フォルダ名の一致判定
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    If Len(Trim(Range("FOLDER_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FOLDER_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
Else
    Range("FOLDER_NAME").Value = Trim(Range("FOLDER_NAME").Value)
End If

'---ファイル名の一致判定
If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
    If Len(Trim(Range("FILE_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FILE_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If

'---拡張子の一致判定
If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
    If Len(Trim(Range("EXT_MATCH_TYPE").Value)) = 0 Then
        MsgBox "拡張子の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("EXT_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "拡張子の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If


Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    '---テーブルが空だとエラーになるのでエラーを無視するようにする
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With

'---まず指定フォルダのファイルを収集する
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    '---指定の場合一致したらファイル情報を取得する
    If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
    '---除外の場合は不一致ならファイル情報取得して再帰処理する
    If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
Else
    Call GetFileData(ws, Range("TARGET_FOLDER").Value)
End If


'-サブフォルダを対象とするか
If Range("TARGET_SUBFOLDER").Value = "する" Then
    Call GetSubFoler(ws, target_folder)
End If
Set ws = Nothing
Application.StatusBar = False

'---先頭行が空白だったら（絶対空白のはず）削除する
If Len(Trim(Range("FILE_TABLE").Item(1).Value)) = 0 Then
    On Error Resume Next
    Range("FILE_TABLE").ListObject.ListRows(1).Delete
    On Error GoTo 0
End If

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub
Sub DeleteFileList()
Dim ws As Worksheet
Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With
Set ws = Nothing

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub
Private Function GetFileData(ws As Worksheet, target_folder As String)
'======================================================================
' 指定フォルダの中にあるファイル情報を取得してリストに反映する
'======================================================================
Dim lngRow As Long
Dim file_path As String
Dim objFile As Scripting.File
Dim get_file_bool As Boolean

Application.StatusBar = target_folder & " のファイル情報を取得中・・・"
For Each objFile In objFso.GetFolder(target_folder).Files
    '---ファイルの取得判定の初期値を設定（True）
    get_file_bool = True
    '---ファイル名検索に指定があったら
    If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
        '---ファイル名（拡張子除く）が条件と一致しているか確認
        If in_array(objFso.GetBaseName(objFile.Name), Split(Range("FILE_NAME").Value, "|"), Range("FILE_MATCH_TYPE").Value) = IIf(Range("FILE_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---拡張子に指定があったら
    If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
        If in_array(objFso.GetExtensionName(objFile.Name), Split(Range("EXT_NAME").Value, "|"), Range("EXT_MATCH_TYPE").Value) = IIf(Range("EXT_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---取得対象と判定されたら情報を取得して書き出す
    If get_file_bool = True Then
        With ws
            .Select
            '---テーブルに行を追加する
            Range("FILE_TABLE").ListObject.ListRows.Add AlwaysInsert:=False
            lngRow = Range("FILE_TABLE").Item(Range("FILE_TABLE").Cells.Count).Row
            .Cells(lngRow, lngCol.file_name).Value = objFile.Name
            .Cells(lngRow, lngCol.ext_name).Value = objFso.GetExtensionName(objFile.Path)
            .Cells(lngRow, lngCol.file_size).Value = objFile.Size
            .Cells(lngRow, lngCol.create_date).Value = objFile.DateCreated
            .Cells(lngRow, lngCol.mod_date).Value = objFile.DateLastModified
            file_path = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path).Value = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path_split).Resize(, UBound(Split(file_path, "\")) + 1) = Split(file_path, "\")
        End With
    End If
continue:
Next
End Function
Private Function GetSubFoler(ws As Worksheet, target_folder As String)
'======================================================================
' 再帰処理でフォルダを潜りながらそのフォルダのファイルを取得する
'======================================================================
Dim objFld As Scripting.Folder

For Each objFld In objFso.GetFolder(target_folder).SubFolders
    '---フォルダ名検索に指定があったら
    If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
        '---指定の場合一致したらファイル情報を取得する
        If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
                Call GetFileData(ws, objFld.Path)
            End If
            '---どちらにしても再帰処理はかける
            Call GetSubFoler(ws, objFld.Path)
        End If
        '---除外の場合は不一致ならファイル情報取得して再帰処理する
        If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
                Call GetFileData(ws, objFld.Path)
                Call GetSubFoler(ws, objFld.Path)
            End If
        End If
    Else
        Call GetFileData(ws, objFld.Path)
        Call GetSubFoler(ws, objFld.Path)
    End If
Next
End Function
Private Function in_array(target_str As String, target_array As Variant, Optional match_type As String = "完全一致") As Boolean
'======================================================================
' パターンに合わせて一致判定を返す
'======================================================================
Dim arr As Variant

For Each arr In target_array
    Select Case match_type
        Case "完全一致"
            If LCase(target_str) = LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case "部分一致"
            If LCase(target_str) Like "*" & LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "前方一致"
            If LCase(target_str) Like LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "後方一致"
            If LCase(target_str) Like "*" & LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case Else
    End Select
Next
in_array = False
End Function

ここからはプログラムをプロシージャ別に解説していきます

共通変数

Option Explicit
Enum lngCol
    file_name = 1
    ext_name
    file_size
    create_date
    mod_date
    file_path
End Enum
Dim objFso As New Scripting.FileSystemObject

個人的な話ですが、昔はプロシージャ―の外に書く共通変数にしたがっていた時期がありましたが最近はなるべく共通変数は減らして値格納する変数はNGにしています

Enum（列挙型）はExcelならではですが、列番号を宣言してあげると後から項目追加・削除したり編集する可能性があるなら便利ですよね

GetFileList（メインプロシージャ―）

Sub GetFileList()
Dim ws As Worksheet
Dim target_folder As String

'---起点フォルダの確認
target_folder = Trim(Range("TARGET_FOLDER").Value)
If objFso.FolderExists(target_folder) = False Then
    MsgBox "対象フォルダが見つかりません", vbCritical
    Exit Sub
End If

'---フォルダ名の一致判定
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    If Len(Trim(Range("FOLDER_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FOLDER_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
Else
    Range("FOLDER_NAME").Value = Trim(Range("FOLDER_NAME").Value)
End If

'---ファイル名の一致判定
If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
    If Len(Trim(Range("FILE_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FILE_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If

'---拡張子の一致判定
If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
    If Len(Trim(Range("EXT_MATCH_TYPE").Value)) = 0 Then
        MsgBox "拡張子の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("EXT_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "拡張子の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If


Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    '---テーブルが空だとエラーになるのでエラーを無視するようにする
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With

'---まず指定フォルダのファイルを収集する
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    '---指定の場合一致したらファイル情報を取得する
    If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
    '---除外の場合は不一致ならファイル情報取得して再帰処理する
    If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
Else
    Call GetFileData(ws, Range("TARGET_FOLDER").Value)
End If


'-サブフォルダを対象とするか
If Range("TARGET_SUBFOLDER").Value = "する" Then
    Call GetSubFoler(ws, target_folder)
End If
Set ws = Nothing
Application.StatusBar = False

'---先頭行が空白だったら（絶対空白のはず）削除する
If Len(Trim(Range("FILE_TABLE").Item(1).Value)) = 0 Then
    On Error Resume Next
    Range("FILE_TABLE").ListObject.ListRows(1).Delete
    On Error GoTo 0
End If

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub

長いように見えてやっていることは

1. エクセルで入力した内容（条件）をチェックする
2. 出力先のシート（厳密にはテーブル）をリセットする
3. 指定したフォルダのファイル情報を取得する

だけです

当たり前ですがエクセルで設定できる項目に比例してソースが長くなってしまうのはやむなし

GetFileData

Private Function GetFileData(ws As Worksheet, target_folder As String)
'======================================================================
' 指定フォルダの中にあるファイル情報を取得してリストに反映する
'======================================================================
Dim lngRow As Long
Dim file_path As String
Dim objFile As Scripting.File
Dim get_file_bool As Boolean

Application.StatusBar = target_folder & " のファイル情報を取得中・・・"
For Each objFile In objFso.GetFolder(target_folder).Files
    '---ファイルの取得判定の初期値を設定（True）
    get_file_bool = True
    '---ファイル名検索に指定があったら
    If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
        '---ファイル名（拡張子除く）が条件と一致しているか確認
        If in_array(objFso.GetBaseName(objFile.Name), Split(Range("FILE_NAME").Value, "|"), Range("FILE_MATCH_TYPE").Value) = IIf(Range("FILE_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---拡張子に指定があったら
    If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
        If in_array(objFso.GetExtensionName(objFile.Name), Split(Range("EXT_NAME").Value, "|"), Range("EXT_MATCH_TYPE").Value) = IIf(Range("EXT_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---取得対象と判定されたら情報を取得して書き出す
    If get_file_bool = True Then
        With ws
            .Select
            '---テーブルに行を追加する
            Range("FILE_TABLE").ListObject.ListRows.Add AlwaysInsert:=False
            lngRow = Range("FILE_TABLE").Item(Range("FILE_TABLE").Cells.Count).Row
            .Cells(lngRow, lngCol.file_name).Value = objFile.Name
            .Cells(lngRow, lngCol.ext_name).Value = objFso.GetExtensionName(objFile.Path)
            .Cells(lngRow, lngCol.file_size).Value = objFile.Size
            .Cells(lngRow, lngCol.create_date).Value = objFile.DateCreated
            .Cells(lngRow, lngCol.mod_date).Value = objFile.DateLastModified
            file_path = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path).Value = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path_split).Resize(, UBound(Split(file_path, "\")) + 1) = Split(file_path, "\")
        End With
    End If
continue:
Next
End Function

まず今回のようなループが多いプログラムはステータスバーに進捗状況を表示してあげると親切

他の言語に慣れるとVBAのForループにcontinueが無いのが地味にストレスなんでGoToで無理矢理再現したことと、PHPで出会ったin_arrayは後述していますがVBAにない関数は自作してしまえってことでこちらも再現しただけの関数を準備しました

他には出力先をテーブル化しているので最下行の指定が通例とちょっと違うことと、フォルダパスを”\”で区切った配列を一気に反映させるためにResizeを使っているところがミソ

細かいこと書きましたがざっくりやっていることは↓↓だけ

1. 引数にあるフォルダ内のファイルをFor Eachでサーチ
2. SETシートで指定したファイルと拡張子の条件と照合
3. 条件一致していればLISTシートにあるテーブルへ書き込む

GetSubFoler

Private Function GetSubFoler(ws As Worksheet, target_folder As String)
'======================================================================
' 再帰処理でフォルダを潜りながらそのフォルダのファイルを取得する
'======================================================================
Dim objFld As Scripting.Folder

For Each objFld In objFso.GetFolder(target_folder).SubFolders
    '---フォルダ名検索に指定があったら
    If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
        '---指定の場合一致したらファイル情報を取得する
        If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
                Call GetFileData(ws, objFld.Path)
            End If
            '---どちらにしても再帰処理はかける
            Call GetSubFoler(ws, objFld.Path)
        End If
        '---除外の場合は不一致ならファイル情報取得して再帰処理する
        If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
                Call GetFileData(ws, objFld.Path)
                Call GetSubFoler(ws, objFld.Path)
            End If
        End If
    Else
        Call GetFileData(ws, objFld.Path)
        Call GetSubFoler(ws, objFld.Path)
    End If
Next
End Function

ここでもin_arrayが登場してるのですが、条件指定を複数できるようにしてるので重宝します

ここでのポイントは再帰処理しているところだけで、これまで通りやっていることを並べると

1. SETシートで指定したフォルダの条件と照合
2. 一致しているもしくは条件指定していないならファイル情報を取得
3. 次の階層のフォルダを同じことを繰り返す

再帰処理はその内説明ページ作ります

in_array

Private Function in_array(target_str As String, target_array As Variant, Optional match_type As String = "完全一致") As Boolean
'======================================================================
' パターンに合わせて一致判定を返す
'======================================================================
Dim arr As Variant

For Each arr In target_array
    Select Case match_type
        Case "完全一致"
            If LCase(target_str) = LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case "部分一致"
            If LCase(target_str) Like "*" & LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "前方一致"
            If LCase(target_str) Like LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "後方一致"
            If LCase(target_str) Like "*" & LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case Else
    End Select
Next
in_array = False
End Function

本家のin_arrayは完全一致だけですが今回の使用目的的にも自作関数なので一致条件を分岐で作りましたが、指定の文字が配列の中にあるかをチェックする関数

Dictionary型で無理矢理取り扱えばExistsもありますが、完全一致以外も処理したいので結局自作関数がベストかと

余談 兼 フリーソフト紹介

今回せっかくVBAで作ったので分解して説明しましたが、ファイルリストを作りたいならフリーソフトのEverythingを使うと爆速で作成できます！

個人的にはWindowsの標準ソフトとして搭載してほしいくらいの便利ソフトなので興味がある方は是非！

窓の杜へのリンク

本家サイトへのリンク

あとがき

せっかく作ったので紹介してみましたが実のところ再帰処理さえ理解していれば9割くらい作れるお手軽プログラムに細かな設定を付け足しただけです

他にもExcelでツール作った時は同じように公開してますのでたまに覗きに来てくれると嬉しいです！

昔作ったVBAのメール送信ツールを引っ張り出してきたら、いつの間にか使えなくなっていたので、改善方法も含めて改めてプログラムや設定方法をまとめてみました

結論から言うと、VBAからGmailを送るならCDO(Microsoft Collaboration Data Objects)を使うのが定番で、Gmail側でアプリパスワードの生成さえ済ませておけば、件名・本文・宛先・添付ファイル付きのメールをマクロから送信できます

OutlookならOutlook専用のライブラリがあるのでそちらを使ったほうが扱いやすいんですが、GmailはCDO経由で送ることになるので、今回はその方法になります

この記事ではGmail側の事前設定から、コピペでそのまま使える送信関数まで、つまづきやすいところを補足しながら解説していきます

最初にやる一番キモなGmailの事前設定

コードを書く前に、実はこのGmail側の設定が一番のキモなんですよね

ここを飛ばすと、コードが正しくてもメールは送れないので、先に片付けておきましょう

安全性の低いアプリのアクセス・・・が使用できない!?

一昔前はこの「安全性の低いアプリのアクセス」を有効化するのがGmail側の設定だったのに、いつの間にか使用できなくなっていました

(結局この部分が、昔は使えていたツールが動かなくなっていた原因でした)

と言うか、気づいていなかっただけで、しっかりGoogleから2022年5月30日より利用できなくなる事前アナウンスが出ていたのはうっかりでした

2026年現在もこの流れは変わっていなくて、個人のGmailでは「安全性の低いアプリのアクセス」はすでに廃止済みです

そのかわりに用意されたのが、次に紹介するアプリパスワードという仕組みなんですね

今は”アプリパスワード”の生成が必要

VBAのようなアプリからGmailへログインするには、普段ログインに使っている本来のパスワードではなく、アプリパスワードの生成が必要になります

2段階認証を有効にしていると、本来のパスワードはSMTPの認証で弾かれてしまうので、ここで作るアプリパスワードがログイン用のカギになるイメージです

設定するページはこちらから

https://myaccount.google.com/security

ちなみに、アプリパスワードの生成ページにはアカウント内検索だと出てこないことがあるので、その場合は https://myaccount.google.com/apppasswords に直接アクセスすると早いです

それでは実際の流れを見ていきましょう、大まかには次の3ステップです

STEP

2段階認証プロセスをオンにする

初期状態では2段階認証プロセスがオフになっているので、まずはここをオンにします

オンにするのは、次のページで“使ってみる”ボタンを押すだけです

SMSや認証アプリ、セキュリティキーといった標準の2段階認証が有効になっていればOKで、ここが済むとアプリパスワードを作れるようになります

STEP

アプリパスワードを生成する

2段階認証プロセスをオンにしたことでアプリパスワードの選択肢が増えているので、ここで設定していきます

アプリ名はアプリパスワードの名前になるだけなので、それらしい選択をすればよくて、”その他”を選ぶとフリー入力に変わります

名前を入れると“生成”ボタンが活性化するので、そのままクリックします

STEP

発行された16桁を控える

ここで表示される16桁の文字列が、いわゆるアプリパスワードです

右下の完了をクリックすると2度と表示されないので、忘れずにパスワードを控えておきましょう

もし控えそびれても、また同じ手順で新しく生成し直せばいいので、そこは安心してくださいね

ちなみに、画像は記事公開当時のものなので、今は項目名やレイアウトが少し違って見えることがあります

とはいえ「2段階認証をオン → アプリパスワードを生成 → 16桁を控える」という骨子は変わっていないので、流れさえ押さえておけば迷わないと思います

このCDO方式はいつまで使える?

長く使ってきた方式なので、これからも使えるのか気になるところですよね

そのあたりの現況だけ、簡単に注意としてまとめておきます

そうは言っても、個人利用の範囲ではまだまだ現役なので、まずは今回のCDO方式で送れるようにしておけば十分じゃないでしょうか

VBAの参照設定

続いてVBA側の準備です、参照設定で次のライブラリにチェックを入れます

Microsoft CDO for Windows 2000 Library

名前に「2000」と入っていて古そうに見えますが、これがCDO(CDO.Message)のライブラリで、今のWindowsにも標準で入っています

実際のVBAプログラム

お待たせしました、ここからが本体です

プログラムソース

件名・本文・宛先(To/Cc/Bcc)・添付ファイルまで一通り扱える送信関数です、コードの上のほうにあるmailUser と mailPass を、自分のGmailアドレスと先ほどのアプリパスワードに書き換えるだけで使えます

Function sendMail(MailSubject As String, MailBody As String, ToAddress As String, _
                    Optional CcAddress As String = vbNullString, Optional BccAddress As String = vbNullString, Optional attFile As Variant = vbNullString)

Const mailUser As String = "<Gmailのメアド>"
Const mailPass As String = "<アプリパスワード>"

Dim cdoMsg As Object: Set cdoMsg = CreateObject("CDO.Message")
Dim objFso As Object: Set objFso = CreateObject("Scripting.FileSystemObject")
Dim i As Long

With cdoMsg
    With .Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = "shift-jis" '---文字コード指定
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 '---外部SMTP指定
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" '---SMTPサーバ名
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "465" '---ポート№
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True '---SMTP認証
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True '---SSL
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 '---タイムアウト
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailUser '---ユーザー
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailPass '---パスワード
        .Update
    End With
    .Subject = MailSubject
    .TextBody = MailBody
    .TextBodyPart.Charset = "ISO-2022-JP"
    .From = mailUser
    .To = ToAddress
    .CC = CcAddress
    .BCC = BccAddress
    
    '---添付ファイルが複数（配列形式）かの分岐
    If IsArray(attFile) = True Then
        For i = LBound(attFile) To UBound(attFile)
            '---ファイルが存在してれば添付する
            If objFso.FileExists(attFile(i)) Then
                .AddAttachment attFile(i)
            End If
        Next
    Else
        '---ファイルが存在してれば添付する
        If objFso.FileExists(attFile(i)) Then
            .AddAttachment attFile(i)
        End If
    End If
    .Send
End With

Set cdoMsg = Nothing
Set objFso = Nothing
End Function

送信に関わる設定は .Configuration.Fields のあたりに集まっていて、ポイントはsmtp.gmail.com / ポート465 / SSLの3点です、ここがGmailで送るための決まりごとになります

余談ですが、参照設定をしたのになぜ”cdoMsg”のデータ型を”Object”にするのかと言うと、これならコピペするだけで(≒参照設定をしなくても)プログラムが利用できるからです

自分好みに改修したいときは、Objectから具体的な型への変更をおススメします

ざっくり説明

コード自体はコピペで動くので、ここでは使うとき用に引数だけ説明しておきます

1点だけ補足すると、添付ファイルを1つ(配列ではなく単体の文字列)で渡したときは、お使いの環境によっては添付がスキップされることがあります、確実に添付したいときは Array("C:\temp\a.pdf") のように1件でも配列で渡すと安定しますよ

呼び出すときは、必須の3つを渡すだけでも送れます、たとえばこんな感じです

'---件名・本文・宛先だけ渡すシンプルな呼び出し
Call sendMail("テスト送信", "本文です", "to@example.com")

'---添付ファイルを1つ付けて送る
Call sendMail("見積書の件", "ご確認ください", "to@example.com", , , "C:\temp\mitsumori.xlsx")

'---複数の添付ファイルは配列で渡す
Call sendMail("資料一式", "まとめてお送りします", "to@example.com", , , Array("C:\temp\a.pdf", "C:\temp\b.pdf"))

CcやBccを飛ばしたいときは、引数をカンマで詰めて空けておけば、Optionalの初期値がそのまま使われます

送信できないときに確認したいこと

実行してエラーになったり、送れているはずなのに届かなかったり、というのはよくあるので、つまづきやすいポイントをチェックリストにしておきます

• 2段階認証がオンになっているか、オフのままだとアプリパスワード自体が作れません
• mailPassに入れたのがアプリパスワードか、普段ログインに使う本来のパスワードだと認証で弾かれます
• アプリパスワードの16桁を、空白を入れずに貼り付けているか
• サーバとポートがsmtp.gmail.com / 465になっていて、SSLがTrueか
• 会社の回線などで、ポート465の通信がファイアウォールで止められていないか
• Google Workspace(法人)の場合、管理者がレガシー認証を制限していないか

個人的には、エラーが出たときはまずアプリパスワードを作り直して貼り直すのが手っ取り早い切り分けだと思います

よくある質問(FAQ)

最後に、VBAでGmailを送るときによく聞かれるところをまとめておきます

あとがき

今はAPIやWebhookでLINEなどにも通知できるので、メールの出番は減った気もしますが、メール通知もまだまだ現役で、きっとGmailが利用頻度が高いのではとまとめてみました

ちなみにVBAは、外部とのデータ連携でもけっこう活躍してくれて、APIのレスポンスを扱うVBAでJSONをパースする方法もまとめているので、あわせて読んでみてください

まずは今回のCDO方式でGmailが送れるようになれば、定型メールの自動化はだいぶ楽になるはずです、Outlook版もそのうちまとめるので、よかったらまた覗いてみてくださいね