【VBA】指定したフォルダ直下にあるExceファイル(xlsm)の標準モジュールをエクスポートする

サンプルプログラム概要

・対象は直下にあるExceファイル(xlsm)のみ。サブフォルダ配下のファイルは対象外
・エクスポートするのは標準モジュールのみ
・ エクスポートする標準モジュールのファイル名は「ファイル名_標準モジュール名.bas」

準備

入力/出力フォルダを設定するセルを決める。ここでは「B3」と「B6」とする

サンプルプログラム

'●MainModule
Option Explicit

Sub execButton_click()
    
    Dim ws As Worksheet
    Dim inputFolder As String
    Dim outputFolder As String
    
    '初期化処理
    Call init(False)
    
    '入力/出力フォルダを取得
    Set ws = ActiveSheet
    inputFolder = ws.range("B3").Value
    outputFolder = ws.range("B6").Value
    
    '標準モジュールのエクスポート
    Call exportStandardModule(inputFolder, outputFolder)
    
    '後片付け
    Set ws = Nothing
    
    '初期化処理
    Call init(True)
    
End Sub

'初期化処理
'画面描画/イベント/確認メッセージ/自動計算の抑止、抑止解除
Private Function init(status As Boolean)
    
    With Application
        .ScreenUpdating = status
        .EnableEvents = status
        .DisplayAlerts = status
        
        If status Then
            .Calculation = xlCalculationAutomatic
        Else
            .Calculation = xlCalculationManual
        End If
    End With

End Function

'●exportModule
Option Explicit

'標準モジュールのエクスポート
Public Function exportStandardModule(inputFolder As String, outputFolder As String)

    Dim fso As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '標準モジュールのエクスポート
    Call execStandardExportModule(inputFolder, outputFolder, fso)
    
    Set fso = Nothing

End Function

'標準モジュールのエクスポート
Private Function execStandardExportModule(inputFolder As String, _
                                  outputFolder As String, _
                                  fso As Object)
    
    Const TARGET_FILE_TYPE As String = "xlsm"
    
    Dim file As Object
    Dim folders As Object
    Dim ws As Worksheet
    Dim wk As Workbook
    Dim i As Integer
    Dim VBComponents As Object
    
    Set ws = ActiveSheet
       
    'ファイル数分繰り返し
    For Each file In fso.getFolder(inputFolder).files
        If LCase(fso.GetExtensionName(file.Name)) = TARGET_FILE_TYPE Then
            
            'Excelファイルを開く　※「リンクの更新」はしないで開く
            Set wk = Workbooks.Open(Filename:=file.Path, UpdateLinks:=0)
        
            'モジュール数分繰り返し
            Set VBComponents = wk.VBProject.VBComponents
            
            For i = 1 To VBComponents.count
                '標準モジュールのみを対象
                If VBComponents(i).Type = 1 Then
                    VBComponents(VBComponents(i).Name).Export _
                                    outputFolder & _
                                    "\" & _
                                    fso.GetBaseName(file.Name) & _
                                    "_" & _
                                    VBComponents(i).Name & _
                                    ".bas"
                End If
            Next
            
            'Excelファイルを保存せずに閉じる
            wk.Close SaveChanges:=False
            
        End If
    Next
    
    '後片付け
    Set VBComponents = Nothing
    Set ws = Nothing
    Set wk = Nothing
    
End Function

実行結果