【Access】不真面目にシステム開発を考える4～メインメニュー作成～

if not exist C:\プログラム\Access mkdir C:\プログラム\Access
copy /Y C:\Accessシステム研究部\src\A_001_Library.accdb C:\プログラム\Access\A_001_Library.accdb
copy /Y C:\Accessシステム研究部\src\A_002_メインメニュー.accdb C:\プログラム\Access\A_002_メインメニュー.accdb
start "C:\Program Files\Microsoft Office\root\Office16\MSA_ESS.EXE" "C:\プログラム\Access\A_002_メインメニュー.accdb" /runtime
exit /B 0

Option Compare Database
Option Explicit

Public Const PF_PGM_COPY_DRECTORY As String = "C:\Accessシステム研究部\src\"
Public Const PF_PGM_PASTE_DRECTORY As String = "C:\プログラム\Access\"

Option Compare Database
Option Explicit

'Accessをコピペしてファイルを開く
Public Sub PS_AccessOpen(ByVal fileName As String, Optional macroName As String = "")

    'ディレクトリの作成
    Call addDirectory

    '共通関数をコピペ
    Call copyAndPaste("A_001_Library.accdb")

    '指定ファイルのコピペ
    Call copyAndPaste(fileName)

    'ファイルを開く
    Call fileOpen(fileName)

End Sub


'ファイルを開く
Private Sub fileOpen(ByVal fileName As String)

    Shell "MSAccess.exe /runtime" & PF_PGM_PASTE_DRECTORY & fileName, vbMaximizedFocus

End Sub

'ファイルをコピペ
Private Sub copyAndPaste(ByVal name As String)

    Dim fileSystemObject As Object
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")

    fileSystemObject.CopyFile PF_PGM_COPY_DRECTORY & name, PF_PGM_PASTE_DRECTORY & name

    Set fileSystemObject = Nothing

End Sub

'ディレクトリの作成
Private Sub addDirectory()

    If Dir(PF_PGM_PASTE_DRECTORY, vbDirectory) <> "" Then Exit Sub

    '\でスプリット
    Dim dirSplit As Variant
    dirSplit = Split(PF_PGM_PASTE_DRECTORY, "\")

    'ディレクトリ格納用
    Dim dirStr As String
    dirStr = dirSplit(0)

    'フォルダが無ければ作成
    Dim i As Long

    For i = 1 To UBound(dirSplit)

        dirStr = dirStr & "\" & dirSplit(i)

        If Dir(dirStr, vbDirectory) = "" Then

            MkDir dirStr

        End If

    Next

End Sub

Private Sub c_btn_システム研究部_Click()

    Call ps_accessOpen("A_003_システム研究部メニュー.accdb", "")

End Sub