表示調整
閉じる
挿絵表示切替ボタン
▼配色
▼行間
▼文字サイズ
▼メニューバー
×閉じる

ブックマークに追加しました

設定
0/400
設定を保存しました
エラーが発生しました
※文字以内
ブックマークを解除しました。

エラーが発生しました。

エラーの原因がわからない場合はヘルプセンターをご確認ください。

1/2

[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 フォルダにエクスポートされます)。


評価をするにはログインしてください。
この作品をシェア
Twitter LINEで送る
ブックマークに追加
ブックマーク機能を使うにはログインしてください。
― 新着の感想 ―
このエピソードに感想はまだ書かれていません。
感想一覧
+注意+

特に記載なき場合、掲載されている作品はすべてフィクションであり実在の人物・団体等とは一切関係ありません。
特に記載なき場合、掲載されている作品の著作権は作者にあります(一部作品除く)。
作者以外の方による作品の引用を超える無断転載は禁止しており、行った場合、著作権法の違反となります。

この作品はリンクフリーです。ご自由にリンク(紹介)してください。
この作品はスマートフォン対応です。スマートフォンかパソコンかを自動で判別し、適切なページを表示します。

↑ページトップへ