モジュールインポート
アクティブワークブックの標準モジュールをバックアップフォルダからインポートします。
指定したモジュールはインポートしないようにします。（モジュール削除参照）
  1. 参照設定 で「Microsoft Scripting Runtime」にチェックを付けます。
  2. 赤字 は環境に合わせて設定する部分です。
モジュールインポート
Option Explicit

Dim mypBkupPath As String            'BackUp パス名

Sub KMoImportCom00()

''Module Import Start           2002/9/4

    Dim mypActName As String        'ActiveWorkbook Name
    Dim mypBkupFolder As String     'BackUp フォルダ名
    Dim mypZMoname1 As String       'インポートしないモジュール名の先頭文字
    Dim mypZMoname2 As String       'インポートしないモジュール名の先頭文字

    mypZMoname1 = "A"
    mypZMoname2 = "a"
    mypBkupPath = "D:\My Documents\BkupBAS\"

    mypActName = ActiveWorkbook.Name

''モジュールフォルダ 選択          2002/9/4
    mypBkupFolder = KMoFolderCoice(mypActName)

    mypBkupPath = mypBkupPath & mypBkupFolder & "\"

''モジュールインポート共通       2002/5/22
    KMoImport01 mypActName, mypZMoname1, mypZMoname2

End Sub

Sub KMoImport01(mypBookName As String, mypZM1 As String, mypZM2 As String)

''モジュールインポート共通       2002/5/22

    Dim mypFSO As New filesystemobject   '参照設定で Microsoft Scripting Runtime にチェック
    Dim mypFname As File
    Dim mypInName As String

    Dim mypFcnt As Integer
    Dim mypMoName As String            'モジュール名
    Dim mypMoType As Integer           'モジュール型  1:標準 2:Class 3:Form
    Dim mypMoCount As Integer          'モジュール数
    Dim mypBookA As Workbook
    Dim mypTitle As String
    Dim mypMsg1 As String
    Dim mypMsg2 As String
    Dim mypMsg3 As String
    Dim mypRetMsg As Integer

    Set mypBookA = Workbooks.Item(mypBookName)

    mypTitle = "モジュールインポート"
    mypMsg1 = "インポート終了  "
    mypMsg2 = "インポートしますか。？  "
    mypMsg1 = mypMsg1 & vbCrLf & vbCrLf & mypBkupPath & "  [ "
    mypMsg2 = mypMsg2 & vbCrLf & vbCrLf & mypBkupPath & "  [ "

''モジュールインポートの確認
    With mypFSO.GetFolder(mypBkupPath)
        For Each mypFname In .Files
            mypFcnt = .Files.Count
            mypMoName = mypFname.Name
            If Right(mypMoName, 1) = "s" Then
                If Left(mypMoName, 1) = mypZM1 Or Left(mypMoName, 1) = mypZM2 Then
                Else
                   mypMoCount = mypMoCount + 1
                End If
            End If
        Next
    End With
    Beep
    mypMsg3 = mypMsg2 & mypMoCount & " ] → [ "
    mypMsg2 = mypMsg3 & mypBookName & " ]"
    mypRetMsg = MsgBox(mypMsg2, vbYesNo + vbQuestion, mypTitle)
    If mypRetMsg = vbNo Then
       End
    End If

''モジュールインポート
    mypMoCount = 0
    With mypFSO.GetFolder(mypBkupPath)
        For Each mypFname In .Files
            mypFcnt = .Files.Count
            mypMoName = mypFname.Name
            If Right(mypMoName, 1) = "s" Then
                If Left(mypMoName, 1) = mypZM1 Or Left(mypMoName, 1) = mypZM2 Then
                Else
                    mypMoCount = mypMoCount + 1
                    mypInName = mypBkupPath & mypMoName

                    ''マクロモジュールインポート
                    mypBookA.VBProject.VBComponents.Import mypInName
                End If
            End If
        Next
    End With
    Beep
    mypMsg3 = mypMsg1 & mypMoCount & " ] → [ "
    mypMsg1 = mypMsg3 & mypBookName & " ]"
    MsgBox mypMsg1, vbInformation, mypTitle

End Sub
top