【FileSystemObjectによる再帰的ファイル探索】社内サーバー内全SWファイルのバージョン＆整合性チェック基盤
არ
長年、製造業のCADインフラや大規模設計データ管理の現場に身を置いてきた者なら、誰もが一度は悪夢を見る。
「社内ネットワークの奥深く、無限にネストされたフォルダ群に眠る数万ファイルのSolidWorksデータ。その中に混ざる、異なるバージョン、壊れた参照関係、そしてゾンビ化したロックファイル……」
手動での確認など論外だ。Windows Explorerの検索も、ネットワーク越しでは使い物にならない。
今回は、VBAの限界を突破し、社内サーバー上の全SolidWorksファイルを網羅して「バージョン」「ファイル整合性」「参照切れ」を一網打尽にする、極限まで最適化された探索・診断基盤のアーキテクチャを公開する。
レガシーなVBAであっても、設計思想とメモリ管理を極めれば、エンタープライズ水準の堅牢な自動化ツールへと昇華できることを証明しよう。
—
1. アーキテクチャの全体像と技術的課題
今回の基盤が目指すのは、単なる「ファイル名の列挙」ではない。以下の要件を高次元で両立させる。
1. 無限階層への対応: FSOによる再帰呼び出し（Recursion）の安全な実装。
2. メモリリークの完全排除: 巨大なCOMオブジェクト群（SldWorks, ModelDoc2等）のライフサイクル管理。
3. ネットワークI/Oの最適化: サーバー負荷を抑えつつ、確実ファイルを捕捉する例外ハンドリング。
4. サイレントモードの徹底: バックグラウンド処理におけるダイアログポップアップの完全ブロック。
SolidWorks VBAにおける最大の罠：COMの残骸
VBAでSolidWorks APIを叩く際、最も恐ろしいのは「見えないインスタンスの残骸（ゾンビプロセス）」だ。特にファイルを開いてバージョン情報を取得する処理では、エラー発生時に`SldWorks`や`ModelDoc2`がメモリ上に残留し、やがてPCをフリーズさせる。
これを防ぐには、厳格な`On Error Goto`によるクリーンアップパターンが不可欠となる。
—
2. 実装コード：堅牢なる再帰的ファイルチェッカー
以下のコードは、指定されたルートフォルダを起点に、配下の`.sldprt`, `.sldasm`, `.slddrw`をすべて走査し、ファイルバージョンや読み込み整合性を検証するメインエンジンである。
‘ ==============================================================================
‘ ódulo: modSwFileValidator
‘ 概要: FileSystemObjectによる再帰的ファイル探索とSWファイル整合性チェック基盤
‘ 著者: チーフアーキテクト
‘ ==============================================================================
Option Explicit
‘ Win32 API: ネットワーク経由のファイルアクセスの安定化・処理落ち対策（必要に応じて拡張）
Private Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
‘ 処理統計用パブリック構造体
Public Type AuditStats
TotalFiles As Long
SuccessCount As Long
CorruptCount As Long
VersionMismatchCount As Long
ErrorCount As Long
End Type
Private swApp As SldWorks.SldWorks
Private stats As AuditStats
Sub RunServerFileAudit()
Dim fso As Object
Dim targetPath As String
Dim startTime As Double
startTime = Timer
targetPath = “\\fileserver\DesignData\202X_Projects” ‘ 実際の社内サーバーパスを指定
‘ 1. 統計情報の初期化
ResetStats stats
‘ 2. SldWorksの起動（バックグラウンド・完全非表示）
If Not InitializeSolidWorks(swApp) Then
MsgBox “SolidWorksの起動に失敗しました。”, vbCritical
Exit Sub
End If
‘ 3. FSOの生成
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(targetPath) Then
MsgBox “指定されたルートフォルダが存在しません: ” & targetPath, vbCritical
GoTo CleanUp
End If
MsgBox “ファイル監査を開始します。” & vbCrLf & “対象パス: ” & targetPath, vbInformation
‘ 4. 再帰的探索の実行
RecursiveExploreFolders fso.GetFolder(targetPath), swApp, stats
‘ 5. 結果出力
MsgBox “監査完了 (処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒)” & vbCrLf & _
“総ファイル数: ” & stats.TotalFiles & vbCrLf & _
“正常: ” & stats.SuccessCount & vbCrLf & _
“破損疑い: ” & stats.CorruptCount & vbCrLf & _
“エラー: ” & stats.ErrorCount, vbInformation
CleanUp:
‘ 6. 厳格なメモリ解放
TerminateSolidWorks swApp
Set fso = Nothing
End Sub
‘ ——————————————————————————
‘ FSO再帰探索コアプロシージャ
‘ ——————————————————————————
Private Sub RecursiveExploreFolders(ByRef parentFolder As Object, ByRef appRef As SldWorks.SldWorks, ByRef st As AuditStats)
Dim subFolder As Object
Dim file As Object
Dim ext As String
On Error GoTo ErrorHandler
‘ フォルダ内のファイルを処理
For Each file In parentFolder.Files
ext = LCase(CreateObject(“Scripting.FileSystemObject”).GetExtensionName(file.Name))
Select Case ext
Case “sldprt”, “sldasm”, “slddrw”
st.TotalFiles = st.TotalFiles + 1
ProcessFile file.Path, appRef, st
End Select
Next file
‘ サブフォルダを再帰的に走査
For Each subFolder in parentFolder.SubFolders
‘ システムフォルダや隠しフォルダのスキップ判定を入れると安全
If (subFolder.Attributes And 2) = 0 Then ‘ 2 = Hidden
RecursiveExploreFolders subFolder, appRef, st
End If
Next subFolder
Exit Sub
ErrorHandler:
‘ ネットワーク切断やアクセス権限エラーのハンドリング
st.ErrorCount = st.ErrorCount + 1
Resume Next
End Sub
‘ ——————————————————————————
‘ 個別ファイルの検証とバージョン取得
‘ ——————————————————————————
Private Sub ProcessFile(ByVal filePath As String, ByRef appRef As SldWorks.SldWorks, ByRef st As AuditStats)
Dim docType As Long
Dim version As Long
Dim errors As Long
Dim warnings As Long
Dim modelDoc As SldWorks.ModelDoc2
On Error GoTo FileError
‘ ファイルのドキュメントタイプを推定
docType = GetDocumentType(filePath)
‘ 【極めて重要】Silent Modeでのオープン
‘ ユーザーインターフェースを表示せず、参照切れであってもダイアログを出させない
‘ swOpenDocOptions_Silent (1) または swOpenDocOptions_LoadModelReferences などを組み合わせる
Set modelDoc = appRef.OpenDoc6(filePath, docType, 1, “”, errors, warnings)
If modelDoc Is Nothing Then
‘ ファイルが破損しているか、排他制御がかかっている、あるいは開けない状態
st.CorruptCount = st.CorruptCount + 1
LogToCSV filePath, “CORRUPT”, “OpenDoc6 returned Nothing. Errors: ” & errors
Else
‘ バージョン取得 (例: SolidWorks 2023 なら 31 などが返る)
version = appRef.GetDocumentVersion(filePath)
‘ 整合性OK
st.SuccessCount = st.SuccessCount + 1
‘ 必要に応じてここでメタデータやプロパティの抽出を行う
‘ 【必須】開いたドキュメントをメモリから即座に解放
appRef.CloseDoc modelDoc.GetTitle
End If
Set modelDoc = Nothing
Exit Sub
FileError:
st.ErrorCount = st.ErrorCount + 1
LogToCSV filePath, “ERROR”, Err.Description
If Not modelDoc Is Nothing Then
appRef.CloseDoc modelDoc.GetTitle
Set modelDoc = Nothing
End If
Resume Next
End Sub
‘ ——————————————————————————
‘ 補助関数群
‘ ——————————————————————————
Private Function InitializeSolidWorks(ByRef appRef As SldWorks.SldWorks) As Boolean
On Error GoTo InitErr
Set appRef = New SldWorks.SldWorks
appRef.Visible = False ‘ バックグラウンド実行の肝
InitializeSolidWorks = True
Exit Function
initErr:
InitializeSolidWorks = False
End Function
Private Sub TerminateSolidWorks(ByRef appRef As SldWorks.SldWorks)
On Error Resume Next
If Not appRef Is Nothing Then
appRef.ExitApp
Set appRef = Nothing
End If
End Sub
Private Function GetDocumentType(ByVal path As String) As Long
Dim ext As String
ext = LCase(Mid(path, InStrRev(path, “.”) + 1))
Select Case ext
Case “sldprt”: GetDocumentType = 1 ‘ swDocPART
Case “sldasm”: GetDocumentType = 2 ‘ swDocASSEMBLY
Case “slddrw”: GetDocumentType = 3 ‘ swDocDRAWING
Case Else: GetDocumentType = 0
End Select
End Function
Private Sub ResetStats(ByRef st As AuditStats)
st.TotalFiles = 0
st.SuccessCount = 0
st.CorruptCount = 0
st.VersionMismatchCount = 0
st.ErrorCount = 0
End Sub
Private Sub LogToCSV(ByVal path As String, ByVal status As String, ByVal details As String)
‘ 簡易ログ出力の実装（必要に応じてFileSystemObjectでテキストストリーム出力）
Dim fileNum As Integer
fileNum = FreeFile
Open ThisWorkbook.Path & “\AuditLog.csv” For Append As #fileNum
Print #fileNum, Format(Now, “yyyy/mm/dd hh:nn:ss”) & “,” & Chr(34) & path & Chr(34) & “,” & status & “,” & Chr(34) & details & Chr(34)
Close #fileNum
End Sub
—
3. チーフアーキテクトが解説する「現場で活きる」実装の急所
1. `OpenDoc6` のオプション選択とサイレント実行
ネットワーク経由で数千のファイルを開閉する場合、最も恐ろしいのは「参照ファイルが見つかりません」というダイアログによるスクリプトの停止だ。
`OpenDoc6` の第3引数（オプション）に `swOpenDocOptions_Silent`（通常値 `1`）を確実に渡し、かつUIを表示しない `appRef.Visible = False` を組み合わせることで、完全な無人自動化（Headless Execution）を実現している。
2. COMオブジェクトの参照切りの鉄則
VBAではガベージコレクションの挙動が曖昧であるため、ループ内でインスタンスを生成・破棄する際は以下のルールを厳守するべきだ。
- ループ内で使用する `modelDoc` は、処理の直後（あるいはエラー発生時）に必ず `Set modelDoc = Nothing` を明示する。
- これを怠ると、数千ファイルを走査した瞬間にメモリが枯渇し、SolidWorks自体がクラッシュするか、PCのメモリを食いつぶす。
3. FSOの再帰におけるスタックオーバーフロー対策
今回のコードでは`Scripting.FileSystemObject`の`SubFolders`コレクションを用いた再帰（Recursion）を行っている。極端にフォルダのネストが深い（例: 50階層以上）環境ではスタックオーバーフローのリスクがゼロではないが、通常の製造業のPDM/PLM前段階の共有サーバー構造（せいぜい10〜15階層）であれば、FSOの再帰は最もシンプルで保守性の高い選択肢となる。
—
4. さらなる高みへ：システム間連携とスケールアップ
この基盤が完成すれば、単なる「エラーチェック」にとどまらず、次のようなエンタープライズ統合の踏み台となる。
- データベース（SQL Server / PostgreSQL）への一括同期: 検出したバージョン情報を夜間バッチでDBに格納し、全社CADデータのバージョンマトリクスをWebダッシュボードで常時可視化する。
- 古いバージョンの強制マイグレーション: 検出された旧バージョンのファイルを、最新のSolidWorks APIでサイレントオープンし、上書き保存（アップグレード）するバッチへの応用。
レガシーなVBAと侮るなかれ。APIのライフサイクルとWindows環境の特性を完全に理解した上で構築されたコードは、高価な市販PDMシステムの一部機能に匹敵する堅牢性とスピードを発揮する。
あなたの管理するサーバーの片隅で眠る数万の資産を、この基盤で完全に掌握してほしい。
