'-------------------------

Function そのACCESSのあるフォルダを特定()

  Dim strMDBPATH As String

  Dim strWORK As String

  Dim i As Integer

  'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている

  strWORK = CurrentDb.Name

  '後ろから１文字単位で￥を探す

  For i = Len(strWORK) To 1 Step -1

  If Mid(strWORK, i, 1) = "\" Then Exit For '￥だったら抜ける

  Next i

  'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする

  strMDBPATH = Mid(strWORK, 1, i)

  MsgBox "ACCESSのあるフォルダを特定 ： " & strMDBPATH

End Function