[VBS]ExcelのVBAソースをファイル出力する。
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 機能 ： ExcelのVBAソースをファイル出力する。
'
' 返り値 ： なし
'
' 引き数 ： Excelファイルのパス (複数可)
'
' 機能説明 ： 本VBSへExcelファイルをドラッグ＆ドロップするか、
' SendToフォルダにショートカットを配置して「右クリック⇒送る」で実行可能。
' Excelファイル内のVBAモジュール、クラス、フォームなどを個別のファイルとして出力します。
'
' 備考 ： Excelにて下記の設定がされていることが前提条件です。
'
' (Excel2003の場合)
' ツール > マクロ > セキュリティ > 信頼できる発行元 >
' 「Visual Basic プロジェクトへのアクセスを信頼する」をチェックオン
'
' (Excel2007以降の場合)
' リボンの「開発」タブ > マクロのセキュリティ >
' 「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する」をチェックオン
'
' 参考: http://support.microsoft.com/kb/282830/ja
' ※この設定がないと「プログラミングによるVisual Basicプロジェクトへのアクセスは信頼性に欠けます」
' というエラーメッセージが表示され、処理が続行できません。
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
' FileSystemObjectのインスタンスをスクリプトの冒頭で作成し、使い回します。
Dim fso ' As Object (Scripting.FileSystemObject)
Set fso = CreateObject("Scripting.FileSystemObject")
' 定数定義
Const LOG_FILE_NAME = "VBA_Export_Log.txt"
Const FOR_APPENDING = 8 ' OpenTextFileモード: 追記
Const CREATE_IF_NOT_EXIST = True ' OpenTextFileオプション: ファイルが存在しない場合に作成
' VBAコンポーネントのタイプ定数 (可読性向上のため)
Const VB_COMPONENT_TYPE_STANDARD_MODULE = 1 ' 標準モジュール (.bas)
Const VB_COMPONENT_TYPE_CLASS_MODULE = 2 ' クラスモジュール (.cls)
Const VB_COMPONENT_TYPE_USER_FORM = 3 ' ユーザーフォーム (.frm)
Const VB_COMPONENT_TYPE_ACTIVEX_DESIGNER = 11 ' ActiveX デザイナー (.cls)
Const VB_COMPONENT_TYPE_DOCUMENT_MODULE = 100 ' ドキュメントモジュール (.cls: ThisWorkbook, Sheet1など)
' グローバル変数 (ロギング用ストリーム)
Dim g_logFileStream ' As Object (Scripting.TextStream)
' スクリプトのエントリーポイント
Call Main()
'*******************************************************************************
' 関数名 ： Main
' 機能 ： スクリプトの主処理。コマンドライン引数を処理し、
' 各ExcelファイルのVBAコード出力関数を呼び出します。
' 引数 ： なし
' 戻り値 ： なし
'*******************************************************************************
Sub Main()
Dim objArgs ' WshArgumentsオブジェクト
Dim excelFilePath ' 処理対象のExcelファイルパス
Dim xlApp ' Excel.Applicationオブジェクト
Dim bAppStartedByScript As Boolean ' Excelをこのスクリプトで起動したかどうかのフラグ
Dim bOverallSuccess As Boolean ' 全体の処理が成功したかどうかのフラグ
Set objArgs = WScript.Arguments
bOverallSuccess = True ' 初期値は成功
' ログファイルのパスを設定し、開きます。
Dim logFilePath As String
logFilePath = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), LOG_FILE_NAME)
If Not OpenLogFile(logFilePath) Then
MsgBox "エラー: ログファイル '" & LOG_FILE_NAME & "' を開くことができませんでした。" & vbCrLf & _
"スクリプトの実行を停止します。", vbCritical, "ログファイルエラー"
WScript.Quit
End If
WriteLog "--- 処理開始: " & Now & " ---"
If objArgs.Count = 0 Then
WriteLog "エラー: 処理するExcelファイルが指定されていません。VBSファイルにExcelファイルをドラッグ＆ドロップするか、パスを引数として指定してください。"
bOverallSuccess = False
GoTo EndMain
End If
' Excelアプリケーションの起動または既存のインスタンスへの接続を試みます。
Set xlApp = GetExcelApplication(bAppStartedByScript)
If xlApp Is Nothing Then
WriteLog "致命的エラー: Excelアプリケーションを起動できませんでした。スクリプトの実行を停止します。"
bOverallSuccess = False
GoTo EndMain
End If
' Excelを非表示で実行し、アラート表示を無効にします。
xlApp.Visible = False
xlApp.DisplayAlerts = False
' 取得した引数の数だけループし、各Excelファイルのパスを処理します。
For Each excelFilePath In objArgs
WriteLog "--- ファイル処理開始: " & excelFilePath & " ---"
If Not ProcessExcelFile(xlApp, CStr(excelFilePath)) Then
bOverallSuccess = False ' 1つでも失敗したら全体の成功フラグをFalseに
End If
WriteLog "--- ファイル処理終了: " & excelFilePath & " ---"
Next
EndMain:
WriteLog "--- 処理終了: " & Now & " ---"
' 最終的な結果をユーザーに通知します。
If bOverallSuccess Then
MsgBox "すべてのファイルのVBAコードのエクスポートが完了しました。詳細はログファイルを確認してください。", vbInformation, "処理完了"
Else
MsgBox "VBAコードのエクスポート中にエラーが発生しました。詳細はログファイルを確認してください。", vbCritical, "処理完了 (エラーあり)"
End If
' Excelアプリケーションオブジェクトを適切に解放します。
CleanupExcelApplication xlApp, bAppStartedByScript
' ログファイルとFileSystemObjectをクローズし、解放します。
CleanupObjects
End Sub
'*******************************************************************************
' 関数名 ： OpenLogFile
' 機能 ： ログファイルを開き、g_logFileStreamに設定します。
' 引数 ： logFilePath (String) - ログファイルのフルパス
' 戻り値 ： Boolean - ファイルのオープンに成功した場合True、失敗した場合False
'*******************************************************************************
Private Function OpenLogFile(logFilePath As String) As Boolean
On Error Resume Next ' ログファイルオープンでエラーが発生しても続行
Set g_logFileStream = fso.OpenTextFile(logFilePath, FOR_APPENDING, CREATE_IF_NOT_EXIST)
If Err.Number <> 0 Then
OpenLogFile = False
Else
OpenLogFile = True
End If
On Error GoTo 0
End Function
'*******************************************************************************
' 関数名 ： GetExcelApplication
' 機能 ： 既存のExcelアプリケーションインスタンスを取得するか、新しく起動します。
' 引数 ： bAppStarted (ByRef Boolean) - Excelをこの関数で起動した場合Trueを返します。
' 戻り値 ： Excel.Application - 取得または起動したExcelアプリケーションオブジェクト
'*******************************************************************************
Private Function GetExcelApplication(ByRef bAppStarted As Boolean) As Object
Dim xlApp As Object
bAppStarted = False
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") ' 既存のインスタンスを取得
If Err.Number <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application") ' 新しく作成
If Err.Number = 0 Then
bAppStarted = True
WriteLog "Excelアプリケーションを新しく起動しました。"
Else
WriteLog "エラー: Excelアプリケーションを起動できませんでした。エラー詳細: " & Err.Description
End If
Else
WriteLog "既存のExcelアプリケーションに接続しました。"
End If
On Error GoTo 0
Set GetExcelApplication = xlApp
End Function
'*******************************************************************************
' 関数名 ： ProcessExcelFile
' 機能 ： 指定されたExcelファイルからVBAコードをテキスト形式でエクスポートします。
' 引数 ： xlApp (Excel.Application) - Excelアプリケーションオブジェクト
' stPath (String) - Excelファイルのフルパス
' 戻り値 ： Boolean - 処理が成功した場合True、失敗した場合False
'*******************************************************************************
Private Function ProcessExcelFile(xlApp As Object, stPath As String) As Boolean
Dim wbTarget ' Excel.Workbookオブジェクト
Dim bFileProcessedSuccessfully As Boolean
bFileProcessedSuccessfully = False ' 初期値は失敗
On Error GoTo ErrorHandler
Set wbTarget = Nothing
' ターゲットのExcelブックを開きます (読み取り専用で開くことで、誤ってファイルを変更するのを防ぎます)
WriteLog "ブックを開いています: " & stPath
Set wbTarget = xlApp.Workbooks.Open(stPath, , True) ' 第3引数をTrueで読み取り専用
' VBAソースのエクスポート処理を呼び出します。
If ExportSource(wbTarget) Then
bFileProcessedSuccessfully = True
End If
' ターゲットのブックを閉じます (変更がなければ保存しません)
If Not wbTarget Is Nothing Then
wbTarget.Close False ' Falseを指定して変更を保存しない
WriteLog "ブックを閉じました: " & wbTarget.Name
Set wbTarget = Nothing
End If
ExitProc:
ProcessExcelFile = bFileProcessedSuccessfully
Exit Function ' エラーハンドリングをスキップ
ErrorHandler:
Dim errMsg As String
errMsg = Err.Description
Dim errNum As Long
errNum = Err.Number
WriteLog "エラー発生 (ファイル: " & stPath & "): " & vbCrLf & _
"エラーコード: " & errNum & vbCrLf & _
"説明: " & errMsg
Select Case errNum
Case -2146827284 ' ファイルが見つからない、または開けない、アクセス拒否などの一般的なファイルアクセスエラー
WriteLog "詳細: Excelファイルを開けませんでした。ファイルが存在するか、またはアクセス権があるか確認してください。"
Case 1004 ' VBAプロジェクトへのアクセスが拒否された場合（通常のエラーコード1004の一部として発生）
If InStr(errMsg, "Visual Basic プロジェクトにプログラムからアクセスできません") > 0 Then
WriteLog "詳細: Excelのセキュリティ設定によりVBAプロジェクトにアクセスできません。Excelの「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する」設定が有効になっているか確認してください。"
Else
WriteLog "詳細: Excel処理中に一般的なエラーが発生しました。"
End If
Case Else
WriteLog "詳細: 予期せぬエラーが発生しました。"
End Select
bFileProcessedSuccessfully = False ' このファイルの処理は失敗
' エラー発生時でもブックオブジェクトの解放を試みます。
If Not wbTarget Is Nothing Then
On Error Resume Next ' Closeメソッドでエラーが発生しても処理を続行
wbTarget.Close False
On Error GoTo 0
Set wbTarget = Nothing
End If
Resume ExitProc ' エラー発生後も終了処理に進みます。
End Function
'*******************************************************************************
' 関数名 ： ExportSource
' 機能 ： 指定されたExcelブック内のVBAコンポーネント（モジュール、クラス、フォームなど）
' を個別のファイルとしてエクスポートします。
' 引数 ： wbTarget (Excel.Workbook) - VBAコードをエクスポートするターゲットのブックオブジェクト
' 戻り値 ： Boolean - 全てのエクスポートが成功した場合True、一つでも失敗した場合False
'*******************************************************************************
Private Function ExportSource(wbTarget As Object) As Boolean
Dim stExportPath As String ' エクスポート先のフォルダパス
Dim obVBC ' VBComponentオブジェクト - VBAプロジェクト内の各コンポーネント
Dim stExtension As String ' エクスポートするファイルの拡張子
Dim bAllComponentsExportedSuccessfully As Boolean
bAllComponentsExportedSuccessfully = True ' 初期値は成功
WriteLog "VBAコードのエクスポート開始: " & wbTarget.Name
On Error GoTo ErrorHandler
' エクスポート先のパスを設定 (例: 元ファイルが C:\Users\user\MyBook.xlsm の場合、
' エクスポート先は C:\Users\user\MyBook\ となる)
stExportPath = fso.BuildPath(wbTarget.Path, GetBaseNameFromPath(wbTarget.Name)) & "\"
' エクスポートフォルダが存在しない場合、作成します。
If Not fso.FolderExists(stExportPath) Then
WriteLog "エクスポートフォルダ作成: " & stExportPath
fso.CreateFolder(stExportPath)
End If
' ターゲットブックのVBAプロジェクト内の各コンポーネントをループ処理します。
For Each obVBC In wbTarget.VBProject.VBComponents
' コンポーネントのタイプに応じてファイル拡張子を設定します。
Select Case obVBC.Type
Case VB_COMPONENT_TYPE_STANDARD_MODULE
stExtension = ".bas"
Case VB_COMPONENT_TYPE_CLASS_MODULE
stExtension = ".cls"
Case VB_COMPONENT_TYPE_USER_FORM
stExtension = ".frm"
Case VB_COMPONENT_TYPE_ACTIVEX_DESIGNER
stExtension = ".cls"
Case VB_COMPONENT_TYPE_DOCUMENT_MODULE
stExtension = ".cls"
Case Else
WriteLog "警告: 予期しないVBAコンポーネントタイプが見つかりました: '" & obVBC.Name & "' (タイプ: " & obVBC.Type & ") - スキップします。"
GoTo NextComponent ' 次のコンポーネントへ
End Select
' ファイル出力の実行
Dim exportFileName As String
exportFileName = fso.BuildPath(stExportPath, obVBC.Name & stExtension)
On Error Resume Next ' エクスポート失敗時もエラーを捕捉し、処理を続行
obVBC.Export exportFileName
If Err.Number <> 0 Then
WriteLog "エラー: コンポーネント '" & obVBC.Name & "' のエクスポートに失敗しました。エラーコード: " & Err.Number & ", 説明: " & Err.Description
Err.Clear ' エラーをクリア
bAllComponentsExportedSuccessfully = False ' 1つでも失敗したら全体の成功フラグをFalseに
Else
WriteLog "エクスポート成功: " & exportFileName
End If
On Error GoTo 0 ' エラーハンドラをリセット
NextComponent:
Next
WriteLog "VBAコードのエクスポート完了: " & wbTarget.Name
ExitProc:
ExportSource = bAllComponentsExportedSuccessfully
Exit Function ' エラーハンドリングをスキップ
ErrorHandler:
' VBAプロジェクトアクセスに関する一般的なエラーハンドリング
WriteLog "致命的エラー: VBAコードのエクスポート中に予期せぬ問題が発生しました。" & vbCrLf & _
"原因: " & Err.Description & vbCrLf & _
"エラーコード: " & Err.Number & vbCrLf & _
"対象ファイル: " & wbTarget.Name & vbCrLf & _
"エクスポート先: " & stExportPath & vbCrLf & _
"Excelのセキュリティ設定「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する」が有効になっているか、ファイルパスの正当性を確認してください。"
bAllComponentsExportedSuccessfully = False
Resume ExitProc ' エラー発生後も終了処理に進みます。
End Function
'*******************************************************************************
' 関数名 ： GetBaseNameFromPath
' 機能 ： ファイルパスから拡張子を除いたファイル名を取得します。
' FileSystemObjectのGetBaseNameメソッドを使用。
' 引数 ： stPath (String) - ファイルのフルパスまたはファイル名
' 戻り値 ： String - 拡張子を除いたファイル名
'*******************************************************************************
Private Function GetBaseNameFromPath(stPath As String) As String
GetBaseNameFromPath = fso.GetBaseName(stPath)
End Function
'*******************************************************************************
' 関数名 ： WriteLog
' 機能 ： ログファイルにメッセージを書き込むヘルパー関数です。
' 引数 ： message (String) - ログに書き込むメッセージ
' 戻り値 ： なし
'*******************************************************************************
Private Sub WriteLog(message As String)
If Not g_logFileStream Is Nothing Then
g_logFileStream.WriteLine FormatDateTime(Now, vbGeneralDate) & " - " & message
End If
End Sub
'*******************************************************************************
' 関数名 ： CleanupExcelApplication
' 機能 ： Excelアプリケーションオブジェクトを適切に終了し、解放します。
' 引数 ： xlApp (Excel.Application) - Excelアプリケーションオブジェクト
' bAppStartedByScript (Boolean) - このスクリプトでExcelを起動したか
' 戻り値 ： なし
'*******************************************************************************
Private Sub CleanupExcelApplication(xlApp As Object, bAppStartedByScript As Boolean)
If Not xlApp Is Nothing Then
If bAppStartedByScript Then ' このスクリプトで起動したExcelのみ終了させる
On Error Resume Next ' Quitメソッドでエラーが発生しても処理を続行
xlApp.Quit
On Error GoTo 0
WriteLog "Excelアプリケーションを終了しました。"
Else ' 既存のExcelアプリケーションに接続した場合はDisplayAlertsを元に戻す
On Error Resume Next
xlApp.DisplayAlerts = True
On Error GoTo 0
WriteLog "既存のExcelアプリケーションのアラート表示を有効に戻しました。"
End If
Set xlApp = Nothing
End If
End Sub
'*******************************************************************************
' 関数名 ： CleanupObjects
' 機能 ： ログファイルストリームとFileSystemObjectをクローズし、解放します。
' 引数 ： なし
' 戻り値 ： なし
'*******************************************************************************
Private Sub CleanupObjects()
If Not g_logFileStream Is Nothing Then
g_logFileStream.Close
Set g_logFileStream = Nothing
WriteLog "ログファイルをクローズしました。" ' これはログファイルがクローズされる前にしか書けないので注意
End If
If Not fso Is Nothing Then
Set fso = Nothing
End If
End Sub
このスクリプトの使い方
* 上記のコードを .vbs 拡張子でファイルに保存します（例: ExportVBA.vbs）。
* Excelのセキュリティ設定を確認してください。
* Excel 2003 の場合: ツール > マクロ > セキュリティ > 信頼できる発行元 タブで「Visual Basic プロジェクトへのアクセスを信頼する」にチェックを入れます。
* Excel 2007 以降の場合: 開発 タブ > マクロのセキュリティ > 「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」にチェックを入れます。
* この設定を行わないと、「Visual Basic プロジェクトにプログラムからアクセスできません」というエラーが発生します。
* エクスポートしたいExcelファイル（.xlsm, .xlsなど）を ExportVBA.vbs にドラッグ＆ドロップしてください。複数のファイルを一度にドラッグ＆ドロップすることも可能です。
* 処理が完了すると、VBSファイルと同じディレクトリに VBA_Export_Log.txt というログファイルが作成され、処理の詳細が記録されます。
* 各ExcelファイルのVBAコードは、元のExcelファイルと同じディレクトリに、Excelファイル名と同じ名前の新しいフォルダが作成され、その中にエクスポートされます（例: MyBook.xlsm の場合、MyBook フォルダにエクスポートされます）。
