今回はVBAでワークシート上に記述されたパス設定を読み込む関数を自作したので自分用のメモとして記録します。
思ったより長くなった上にガラパゴス仕様ですので、暇な方だけが御覧ください。
パスの記憶方法について
エクセルVBAで色々作っていると、別のファイルのパスを記述しなければならない場面が必ずあります。
皆さんはどのように記憶させていますか？
ちょっとしたコードならリテラルそのまま・・なんてこともあるかもしれませんが。
パスをリテラルで書いて困る場面というと、こんな時ですかね。
- 同じパスを複数回使用する場合
- 後からパスが変更される場合
- モジュールを別のブックにコピーして使う場合
一般的なパスの記憶方法は、こんなところでしょうか。
- コード中には記述しない
- コード中に記述する
- 使用するモジュールにConstで記述する （△）
- パスを定義する専用モジュールにPublic Constで記述する （○）
使用するモジュールに記述するのを△としているのは、処理を記述するモジュールでConstを定義してしまうと、将来モジュールをアップデートする時に修正の手間が発生するからです。
今回使うテーブルの仕様
さて、今回の目的は「エクセルシートにパスを記述する」時のパス情報の取得を行う関数の作成です。
今回使用するパス設定テーブルは次の3列で構成されています。
- A列に何のパスか
- B列にフォルダの絶対パス
- C列にファイル名
この方式だとセルの書き換えで済むので、こんなメリットがありそうです。
まぁ一部はトラブルの元となりやすくデメリットとも言えますが。
扱いやすいので私はこの方法が一番好きです。
今回はこの仕様を抜本的に見直します。
改修前のシステム
それではまず改修前のコードとテーブルをお見せしましょう。
ちなみにパス設定テーブルも、後々のコードも、空想上の産物なので、その点はご安心ください。
実際のコードはこれ以上の糞コードですけどね！
BadCode.bas
Option Explicit 'およそ（20モジュール、数百プロシージャ）で「Worksheets("設定").Range("B7")」のような表現を使っている。 Sub 一覧表を開く() Workbooks.Open Worksheets("設定").Range("B5") & Worksheets("設定").Range("C5"), ReadOnly:=True End Sub 'テキストファイルを開いてアレコレするコードとか Sub 日報読み込み(ymd As Date) Dim dr As String Dim fn As String Dim buf As String dr = Worksheets("設定").Range("B3") fn = Format(ymd, "yyyymm") & Worksheets("設定").Range("C3") Open dr & fn For Input As #1 Do While Not EOF(1) Line Input #1, buf '----- Debug.Print buf '---- Loop Close #1 End Sub 'number : 6桁=平成年2桁＋連番4桁 Sub 計画書を開く(number As String) Dim dr As String Dim fn As String Dim buf As String '\\192.168.1.123\share\hogehogesystem\planning\H31\ dr = Worksheets("設定").Range("B6") & "H" & Left(number, 2) & "\" '計画書310123.xlsm fn = Replace(Worksheets("設定").Range("C6"), ".", number & ".") Workbooks.Open dr & fn End Sub 'フォルダ以下のブックを連続で開いてアレコレする 'ee : 平成年度2桁 Sub 計画書連続読み込み(ee As String) Dim dr As String Dim fn As String Dim buf As String dr = Worksheets("設定").Range("B4") & "H" & ee & "\" fn = Dir(dr) Do While buf <> "" Workbooks.Open dr & fn '----- Debug.Print Cells(1, 1) '----- ActiveWorkbook.Close False buf = Dir() Loop End Sub
テーブル
| 項目 | フォルダ名 | ファイル名 |
|---|---|---|
| システムルート | \\192.168.1.123\share\hogehogesystem\ | |
| 社員日報データ | \\192.168.1.123\share\hogehogesystem\data\ | 社員.txt |
| 月報 | \\192.168.1.123\share\hogehogesystem\月報\ | |
| 一覧表 | \\192.168.1.123\share\hogehogesystem\ | 一覧表.xls |
| 計画書 | \\192.168.1.123\share\hogehogesystem\planning\ | 計画書.xlsm |
| 社員データ | \\192.168.1.123\share\database\ | 社員データ.txt |
| パート日報データ | \\192.168.1.123\share\hogehogesystem\data\ | パート.txt |
問題点
こんなもんでも目的の動作はしているため、利用者視点では問題ありません。
しかし設定を行う人や開発者からすると、この仕様にはすぐに思いつくだけでもこれだけの問題があります。
- 設定シートを含むワークブックが指定されていない。
- Worksheets("設定")が大量に出現する。
- 同じ意味を持つ列番号BとCが大量に出現する。
- 一行で同じ意味を持つ行番号が2回出現する。
- コードから何のパスを読み込んでいるのか読み取れない。
- コード中で自由にパスを改変しており、テーブルから最終的なパスが特定できない。
- テーブルの並び順を変更出来ないため、後から追記した類似するパスが散乱する。
- テーブルのパスがシステムの位置を基準に変化するパスなのか、独立した別のパスなのか判別できない。
これらについて簡単に解説していきます。
コードの問題
まずは下記のコードから分かる問題ですが、
Worksheets("設定").Range("B5") & Worksheets("設定").Range("C5")
設定シートを含むワークブックが指定されていない。
本当はThisWorkbookのことを指したいはずですが、省略したらActiveWorkbookになりますから間違いなく危険ですね。
Worksheets("設定")が大量に出現する。
シート名を「設定」で固定するのは許容出来るにしても、何が起こるか分かりませんからプロパティで1箇所にまとめるとか、定数を宣言すべきですね。
同じ意味を持つ列番号BとCが大量に出現する。
全体を通してB列はフォルダのパス、C列はファイルの名前と決まっているのであれば、せめて定数を宣言するべきですね。
もし設定シートではない別の場面でもRange("B10")とかを使用している場合、関係無いものまで検索にヒットしてしまいますから、誤って書き換えてしまうかもしれません。
一行で同じ意味を持つ行番号が2回出現する。
フォルダパスとファイル名は基本的にセットで使うので、行番号は変数化して1つにまとめるべきですね。
コードから何のパスを読み込んでいるのか読み取れない。
Range("B5")なんて書かれていても5行目が何のパスを示しているのか、テーブルと並べて見ないと分かりません。不便です。
コード中で自由にパスを改変しており、テーブルから最終的なパスが特定できない。
dr = Worksheets("設定").Range("B3") fn = Format(ymd, "yyyymm") & Worksheets("設定").Range("C3")
例えば上記のコードではテーブルから取得したファイル名の前に年月「201801」を追記しています。
この時点でテーブルからは、最終的に求められているパスが特定出来ないため、ユーザーからすれば
\\192.168.1.123\share\hogehogesystem\data\社員.txtを用意したのにエラーが出る。なんてことが起こりそうです。
当然エラー処理として「\\192.168.1.123\share\hogehogesystem\data\201801社員.txtが見つかりません。」などとエラーを出すことで何を目的としたパスか分かるかもしれませんが。どう考えても設計ミスでしょう。
テーブルの問題
次にパス設定を行う人にとっての問題です。
テーブルの並び順を変更出来ないため、後から追記した類似するパスが散乱する。
上記の表で言うと社員日報データとパート日報データがそうですね。
テーブルにパス記述していくにあたって、類似するものは続けて書きたいですよね。
並び順は自由に変更出来るようにしてくれないと利便性が最悪です。
知らずに行の挿入なんてしてしまった暁には、システム全体が動作しなくなります。
テーブルのパスがシステムの位置を基準に変化する相対パスなのか、独立した別のパスなのか判別できない。
上記の表で言うと社員データの\\192.168.1.123\share\database\社員データ.txtですね。
システムの設置位置に関わらず、サーバー上のdatabaseフォルダを参照するわけですから、下手に触ってはいけないパスだということが一目見て分かるようにしないといけません。
実際には数式を使ってシステムルートと文字列をくっつけて絶対パスを生成しているんですが、テーブルの中で数式を使ったりただの定数だったりと、そんな恐ろしいテーブルになっています。
そもそもテーブルというか表ですね。
もしシステムの設置位置を変えたら、一件一件数式の妥当性をチェックしなければならず面倒です。
GetPathSettingモジュール
という訳で、ここまでの問題を解消したモジュールがこちらです。
仕様
まず次の3点のルールを定めました。
コード
前提として以前書いた相対パスを絶対パスに変換するGetAbsolutePathNameEx関数が必要です。
Option Explicit Private Const SETTING_SHEET_NAME = "設定" Private Const SYSTEM_ROOT_KEY = "システムルート" '任意の列の設定値を取り出す 'Key:A列の値 Col:列番号1~ Private Function GetSetting(Key As String, Col As Long) As String '※StaticでDictionaryをキャッシュさせたほうが高速だが、 'ループ中に記述するような関数では無いので速度は必要ないし、 'ユーザーが変更したときに更新忘れの危険性があるためしない。 Dim SettingSheet As Worksheet Set SettingSheet = ThisWorkbook.Worksheets(SETTING_SHEET_NAME) Dim Data As Variant Dim i As Long, j As Long Data = SettingSheet.UsedRange.Value '設定キーに重複が見つかったらシステムを完全停止させる。 Dim Dic As Dictionary: Set Dic = New Dictionary For i = 2 To UBound(Data, 1) If Data(i, 1) <> "" Then If Dic.Exists(Data(i, 1)) Then SettingSheet.Parent.Activate SettingSheet.Visible = xlSheetVisible SettingSheet.Select SettingSheet.Cells(i, 1).Select MsgBox "設定キー[" & Data(i, 1) & "]が重複しています。" End Else Dim ColumnValue As Variant ReDim ColumnValue(1 To UBound(Data, 2)) For j = LBound(Data, 2) To UBound(Data, 2) ColumnValue(j) = Data(i, j) Next Dic.Add Data(i, 1), ColumnValue End If End If Next If Col <= UBound(Data, 2) Then If Dic.Exists(Key) Then GetSetting = Dic(Key)(Col) End If End If End Function 'システムルートディレクトリの定義 '原則としてはThisWorkbook.Pathになるべきなので定義は不要 'どうしてもルートを変えなければならない場面があるため上書き出来るように用意した機能 Public Property Get SystemRoot() As String Dim fso As New FileSystemObject If GetFolderRelative(SYSTEM_ROOT_KEY) = "" Then SystemRoot = ThisWorkbook.Path & "\" Else SystemRoot = GetAbsolutePathNameEx(ThisWorkbook.Path, GetFolderRelative(SYSTEM_ROOT_KEY)) End If End Property '設定に記載されたフォルダを記述された通りに返す。 '必ずしも相対パスとは限らない。 Public Function GetFolderRelative(Key As String, Optional param As Dictionary) As String GetFolderRelative = GetSetting(Key, 2) GetFolderRelative = ReplacePathParam(GetFolderRelative, param) End Function '設定に記載されたフォルダを絶対パスに変換して返す。 Public Function GetFolderAbsolute(Key As String, Optional param As Dictionary) As String GetFolderAbsolute = GetAbsolutePathNameEx(SystemRoot, GetSetting(Key, 2)) GetFolderAbsolute = ReplacePathParam(GetFolderAbsolute, param) End Function '設定に記載されたファイル名を返す Public Function GetFileName(Key As String, Optional param As Dictionary) As String GetFileName = GetSetting(Key, 3) GetFileName = ReplacePathParam(GetFileName, param) End Function '設定に記載されたフルパスを返す Public Function GetFullPath(Key As String, Optional param As Dictionary) As String GetFullPath = GetAbsolutePathNameEx(SystemRoot, GetSetting(Key, 2)) & GetSetting(Key, 3) GetFullPath = ReplacePathParam(GetFullPath, param) End Function 'パスに含まれる[～]をリストを元に置換した結果を返す Private Function ReplacePathParam(ByVal Path As String, Optional param As Dictionary) As String Dim V As Variant If Not param Is Nothing Then For Each V In param.Keys Path = Replace(Path, "[" & V & "]", param(V)) Next End If For Each V In Split(Path, "\") If V Like "*[[]*[]]*" Then Err.Raise 9999, "Path", "" & V & "に必要なパラメータが不足しています。" End If Next ReplacePathParam = Path End Function
解説
ずいぶんと長くなってしまいました。
簡単にですが順番に解説していきます。
GetSetting関数
テーブルからデータを取り出す部分です。
次のような順で処理してます。
- 設定シートのデータ全部を二次元配列に格納
- 行ごとのデータをDictionaryでA列をキーにして格納
- キー重複を検知したら強制終了
- キーを元にして任意の列データを取り出し
呼び出すたびに設定データを読み込んでいるので、ロスが多いと感じるかもしれませんが、キャッシュすることでキャッシュ後にユーザーが書き換えた場合に意図したとおりに動作しなくなるというデメリットがありますので、今回のように速度を求められない場合は無理に高速化するより毎回読み込むほうがバグが起こりません。
Private Const SETTING_SHEET_NAME = "設定" Private Const SYSTEM_ROOT_KEY = "システムルート" '任意の列の設定値を取り出す 'Key:A列の値 Col:列番号1~ Private Function GetSetting(Key As String, Col As Long) As String '※StaticでDictionaryをキャッシュさせたほうが高速だが、 'ループ中に記述するような関数では無いので速度は必要ないし、 'ユーザーが変更したときに更新忘れの危険性があるためしない。 Dim SettingSheet As Worksheet Set SettingSheet = ThisWorkbook.Worksheets(SETTING_SHEET_NAME) Dim Data As Variant Dim i As Long, j As Long Data = SettingSheet.UsedRange.Value '設定キーに重複が見つかったらシステムを完全停止させる。 Dim Dic As Dictionary: Set Dic = New Dictionary For i = 2 To UBound(Data, 1) If Data(i, 1) <> "" Then If Dic.Exists(Data(i, 1)) Then SettingSheet.Parent.Activate SettingSheet.Visible = xlSheetVisible SettingSheet.Select SettingSheet.Cells(i, 1).Select MsgBox "設定キー[" & Data(i, 1) & "]が重複しています。" End Else Dim ColumnValue As Variant ReDim ColumnValue(1 To UBound(Data, 2)) For j = LBound(Data, 2) To UBound(Data, 2) ColumnValue(j) = Data(i, j) Next Dic.Add Data(i, 1), ColumnValue End If End If Next If Col <= UBound(Data, 2) Then If Dic.Exists(Key) Then GetSetting = Dic(Key)(Col) End If End If End Function
SystemRootプロパティ
コメントの通りです。キーに「システムルート」と記載したパスは特別な処理をするようにしています。
'システムルートディレクトリの定義 '原則としてはThisWorkbook.Pathになるべきなので定義は不要 'どうしてもルートを変えなければならない場面があるため上書き出来るように用意した機能 Public Property Get SystemRoot() As String Dim fso As New FileSystemObject If GetFolderRelative(SYSTEM_ROOT_KEY) = "" Then SystemRoot = ThisWorkbook.Path & "\" Else SystemRoot = GetAbsolutePathNameEx(ThisWorkbook.Path, GetFolderRelative(SYSTEM_ROOT_KEY)) End If End Property
Getほにゃらら関数群
相対フォルダパス、絶対フォルダパス、ファイル名、フルパスを返す関数です。
ここで注目なのはOptional param As Dictionaryの部分で、パス設定テーブルに変数として記述した文字列を置換するためのパラメータを受け取っています。
その置換処理をしているのがこの後のReplacePathParam関数です。
'設定に記載されたフォルダを記述された通りに返す。 '必ずしも相対パスとは限らない。 Public Function GetFolderRelative(Key As String, Optional param As Dictionary) As String GetFolderRelative = GetSetting(Key, 2) GetFolderRelative = ReplacePathParam(GetFolderRelative, param) End Function '設定に記載されたフォルダを絶対パスに変換して返す。 Public Function GetFolderAbsolute(Key As String, Optional param As Dictionary) As String GetFolderAbsolute = GetAbsolutePathNameEx(SystemRoot, GetSetting(Key, 2)) GetFolderAbsolute = ReplacePathParam(GetFolderAbsolute, param) End Function '設定に記載されたファイル名を返す Public Function GetFileName(Key As String, Optional param As Dictionary) As String GetFileName = GetSetting(Key, 3) GetFileName = ReplacePathParam(GetFileName, param) End Function '設定に記載されたフルパスを返す Public Function GetFullPath(Key As String, Optional param As Dictionary) As String GetFullPath = GetAbsolutePathNameEx(SystemRoot, GetSetting(Key, 2)) & GetSetting(Key, 3) GetFullPath = ReplacePathParam(GetFullPath, param) End Function
ReplacePathParam関数
パスに含まれる[～]をパラメータリストを元に置換する関数です。
パスを解析してパラメータが足りていないと、実行時エラーを起こします。
エラーメッセージは一目見ただけで何のパラメータが足りていないのか分かるようにしたつもりです。
'パスに含まれる[～]をリストを元に置換した結果を返す Private Function ReplacePathParam(ByVal Path As String, Optional param As Dictionary) As String Dim V As Variant If Not param Is Nothing Then For Each V In param.Keys Path = Replace(Path, "[" & V & "]", param(V)) Next End If For Each V In Split(Path, "\") If V Like "*[[]*[]]*" Then Err.Raise 9999, "Path", "" & V & "に必要なパラメータが不足しています。" End If Next ReplacePathParam = Path End Function
使用方法
テーブル
テーブルは次のように書き換えました。
システム配下のパスは相対パスに、外部のデータベースは絶対パスで記述しています。
先に記載したとおり相対パスにしたものは、システムルートディレクトリが基準となります。
また、並び順は自由に変更してOKです。
| 項目 | フォルダ名 | ファイル名 |
|---|---|---|
| システムルート | .\ | |
| 社員日報データ | .\data\ | [yyyymm]社員.txt |
| 月報 | .\月報\H[ee]\ | |
| 一覧表 | .\ | 一覧表.xls |
| 計画書 | .\planning\H[ee]\ | 計画書[######].xlsm |
| 社員データ | \\192.168.1.123\share\database\ | 社員データ.txt |
| パート日報データ | .\data\ | [yyyymm]パート.txt |
例1
一番シンプルな例はこんな感じです。
Sub 一覧表() Workbooks.Open GetFullPath("一覧表"), ReadOnly:=True End Sub
GetFullPathにA列のキーを渡しただけでファイルのフルパスが帰ってきます。
超わかりやすいよね・・？
例2
パラメータを必要とするタイプだとこんな感じです。
'number : 6桁=平成年2桁＋連番4桁 Sub 計画書を開く(number As String) Dim fn As String Dim param As Dictionary Set param = New Dictionary param.Add "ee", Left(number, 2) param.Add "######", number fn = GetFullPath("計画書", param) '以下略 Debug.Print fn End Sub
先にパラメータをDictionaryで登録しておいて渡すだけです。
例3
あえてパラメータを付けずに実行してみます。
Sub test_NG() Debug.Print GetFolderAbsolute("計画書") End Sub
このようなエラーが出ます。
実行時エラー'9999': H[ee]に必要なパラメータが不足しています。
まとめ
思った以上に長くなってしまいました。
とりあえずこれで設定テーブルの読み込み機能は完成です。
クラス化しても良いかもしれませんね。
もし同じようなことをしたい人は参考にしていただければと思います。
以上
何か御座いましたらコメント欄、またはTwitterからどうぞ♪
それではまた来週♪ ちゅんちゅん(・8・)
