モジュールエクスポート
カレントデータベースの全ての標準モジュールをバックアップフォルダに エクスポート します。
プロシージャでする理由は
  1. モジュールをひとつずつするのが面倒くさい。
  2. ファイル名に日付をつける事により確認しやすいし、二重のバックアップになる。
  3. モジュール名は モジュール削除 は参照。
  4. モジュールの実行順は　エクスポート→削除→インポート　となります。
手順は
  1. 参照設定 の確認。
  2. モジュールをエクスポートするフォルダを作ります。　例：D:\My Documents\ACCESS\Bas00
  3. データベース毎のサブフォルダを作ります。　例：hp.mdb → 「Homepage」
  4. エクスポートされるファイル名は「モジュール名.Bas」となります。
    例：A0ModuleSave.Bas、A0ModuleSave_0107.Bas（日付を付加した場合）
  5. 三つのプロシージャは 同じモジュール に入れて下さい。
  6. 赤字 は環境に合わせて設定する部分です。
VBComponent オブジェクトの Type プロパティの設定値は、次のとおりです。 
  定数                   値  内容
vbext_ct_StdModule        1  標準モジュール
vbext_ct_ClassModule      2  クラス モジュール
vbext_ct_MSForm           3  Microsoft Form
vbext_ct_ActiveXDesigner 11  ActiveX デザイナ
vbext_ct_Document       100  Document モジュール
モジュール エクスポート▲ TOP
Option Compare Database
Option Explicit

Dim mypActName As String        'ActiveDatabase Name
Dim mypBkUpFPath As String      'BackUp フルパス名
Dim mypBkFolder As String       'BackUp フォルダ名

Const mypBkPath As String = "D:\My Documents\ACCESS\Bas00\"   'BackUp パス名

Function FMoFolderCoice(mypActName As String)

''モジュールフォルダ 選択          2002/10/19
'    mypf=FMoFolderCoice( mypActName)

    Dim mypZname As String
    Dim mypZFolder As String
    Dim mypZMsg1 As String
    
    mypZMsg1 = " ] フォルダが設定されていません。    "

    If mypActName = "Master.mdb" Then
        mypZFolder = "Master"
    ElseIf mypActName = "個人.mdb" Then
        mypZFolder = "個人"
    ElseIf mypActName = "パソコン.mdb" Then
        mypZFolder = "パソコン"
    ElseIf mypActName = "hp.mdb" Then
        mypZFolder = "Homepage"
    Else
        mypZMsg1 = "[ " & mypZname & mypZMsg1
        MsgBox mypZMsg1, vbCritical
        End
    End If

    FMoFolderCoice = mypZFolder
    
End Function

Function FMoExportCom00()

''Module Export Start           2002/10/19
'    FMoExportCom00

''フルパスファイル名からファイル名を取り出す
    mypActName = FPickUpName(1)
    
''モジュールフォルダ 選択          2002/9/4
    mypBkFolder = FMoFolderCoice(mypActName)
    
    mypBkUpFPath = mypBkPath & mypBkFolder & "\"

''モジュールエクスポート 共通1           2002/5/22
    PMoExport01 mypActName

'MsgBox mypBkPath

End Function

Sub PMoExport01(mypDbName As String)

''モジュールエクスポート 共通1           2002/5/22
'    PMoExport01 mypDbName

    Dim myVBAComp As Object
    Dim mypMoName As String            'モジュール名
    Dim mypMoType As Integer           'モジュール型  1:標準 2:Class 3:Form
    Dim mypMoCount As Integer          'モジュール数
    Dim mypTitle As String
    Dim mypMsg1 As String
    Dim mypMsg2 As String
    Dim mypMsg3 As String
    Dim mypRetMsg As Integer
    
    mypTitle = "Module Export"
    mypMsg1 = "エキスポート終了。     "
    mypMsg2 = "ファイル名に日付を付けますか。？    "
    mypMsg1 = mypMsg1 & vbNewLine & vbNewLine & mypDbName & "  [ "
    mypMsg2 = mypMsg2 & vbNewLine & vbNewLine & mypDbName & "   [ "

''モジュールエクスポートの確認
    For Each myVBAComp In VBE.ActiveVBProject.VBComponents
        mypMoType = myVBAComp.Type
        If mypMoType = 1 Then
            mypMoCount = mypMoCount + 1
        End If
    Next
    Beep
    mypMsg3 = mypMsg2 & mypMoCount & " ] → [ "
    mypMsg2 = mypMsg3 & mypBkUpFPath & " ]    "
    mypRetMsg = MsgBox(mypMsg2, vbYesNoCancel + vbQuestion + vbDefaultButton2, mypTitle)
    If mypRetMsg = vbCancel Then
       End
    End If

'''モジュールエクスポート
    mypMoCount = 0
    For Each myVBAComp In VBE.ActiveVBProject.VBComponents
        mypMoType = myVBAComp.Type
        If mypMoType = 1 Then
            mypMoCount = mypMoCount + 1
            mypMoName = myVBAComp.name

            ''モジュールエクスポート 共通2
            PMoExport02 mypRetMsg, mypMoName
        End If
    Next
    mypMsg1 = mypMsg1 & mypMoCount & " ]"
    MsgBox mypMsg1, vbInformation

End Sub

Sub PMoExport02(mypRetMsg As Integer, mypMoName As String)

''モジュールエクスポート 共通2           2002/5/22
'    PMoExport02 RetMsg,MoName

    Dim mypOutName As String
    Dim myExtName As String
    Dim mypMonth As String
    Dim mypDay As String

    If mypRetMsg = vbYes Then
        mypMonth = Format(Date, "mm")
        mypDay = Format(Date, "dd")
        myExtName = "_" & mypMonth & mypDay & ".Bas"
    ElseIf mypRetMsg = vbNo Then
        myExtName = ".Bas"
    End If

    mypOutName = mypBkUpFPath & mypMoName & myExtName
    VBE.ActiveVBProject.VBComponents(mypMoName).Export (mypOutName)

End Sub

Function FPickUpName(myjob As Integer)

''フルパスファイル名からフォルダ名・ファイル名を取り出す   2002/10/19
'    FPickUpName myJob         '1:ファイル名 2:フォルダ名

    Dim myCDB As Database            'カレントデータベース
    Dim myCDbName As String          'フルパスファイル名
    Dim myFLen As Integer
    Dim myPoint1 As Integer

''カレントデータベース名
    Set myCDB = CurrentDb
    myCDbName = myCDB.name

''フルパスファイル名の文字数
    myFLen = Len(myCDbName)

''myCDbNameの最後から "\" があるかを調べる
    myPoint1 = InStrRev(myCDbName, "\", , vbBinaryCompare)

    If myPoint1 = 0 Then
        MsgBox "Error"
        Exit Function
    End If

    If myjob = 1 Then
        FPickUpName = Mid(myCDbName, myPoint1 + 1, myFLen - myPoint1)
    ElseIf myjob = 2 Then
        FPickUpName = Mid(myCDbName, 1, myPoint1)
    End If

'    MsgBox myCDbName & vbNewLine & vbNewLine & FPickUpName

End Function
top