Option Explicit

'===========================================================
'  *ファイルクラス
'
'  Ver  1.0
'
'  #ref(Z_cFile_1.0.txt)
'  #ref(cFile_1.0.txt)
'
'  **コンストラクタ
'  Private Sub Class_Initialize()
'  **初期化
'  Public Function Initialize()
'  **絶対パス変換
'  Private Function updateRootPathForWin()
'  **パス付ファイル名分離
'  Private Function SplitFileIncPath()
'  **ステータス取得
'  Public Function getStatus()
'  **パス取得
'  Public Function getPathName()
'  **ファイル名取得
'  Public Function getFileName()
'  **ファイル存在チェック
'  Public Function isExist()
'  **ファイル削除
'  Public Function deleteFile()
'  **ファイルオープン（読込用）
'  Public Function openFileForRead()
'  **ファイルオープン（上書用）
'  Public Function openFileForOutput()
'  **ファイルオープン（追記用）
'  Public Function openFileForAppend()
'  **ファイル書き込み
'  Public Function writeFileLine()
'  **ファイルクローズ
'  Public Function closeFile()
'  **終了
'  Public Function Terminate()
'  **デコンストラクタ
'  Private Sub Class_Terminate()
'  **Excel終了時処理
'  Private Sub foExcelApplication_WorkbookBeforeClose()
'  **フィールドクリア
'  Private Sub clearField()
'===========================================================

'パス名
Private fsPathName As String
'ファイル名
Private fsFileName As String
'ファイル��
Private iFileNo As Integer
'Initialize済フラグ
Private fbInitialize As Boolean
'オープン中フラグ
Private lbNowOpenFile As Boolean

Private WithEvents foExcelApplication As Excel.Application

'#
'# コンストラクタ
'#   [引  数]:
'#     なし
'#
Private Sub Class_Initialize()

  Set foExcelApplication = Excel.Application

  Call clearField

End Sub

'#
'# 初期化
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     isFileNameIncPath(String)
'#       ファイル名（パス付）
'#       パスがついていない場合、ブックと同パスとなる
'#       相対パスがついているも、ブックが起点となる
'#
Public Function Initialize( _
  isFileNameIncPath As String _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済でないこと
  If (fbInitialize <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    fsPathName = _
      updateRootPathForWin( _
        SplitFileIncPath(isFileNameIncPath, "\", 1) _
      )
    fsFileName = _
      SplitFileIncPath(isFileNameIncPath, "\", 2)
    
    fbInitialize = True
  End If

  Initialize = lbRet

End Function

'# 絶対パス変換
'#    [戻り値]:
'#      String
'#        絶対パス
'#    [引  数]:
'#      isPathName(String)
'#        パスなし、相対パス
Private Function updateRootPathForWin( _
  isPathName As String _
  ) As String
    
  Dim lsRet As String
  Const csDriveString As String = ":\"
  Const csNetWorkString As String = "\\"
  
  '空の場合、当BOOKの格納パスを返却
  If (isPathName = "") Then
    lsRet = ThisWorkbook.Path
  'すでに絶対パスであった場合、そのまま返却
  ElseIf ( _
    Mid( _
      isPathName, _
      2, _
      Len(csDriveString)) = csDriveString _
  ) Then
    lsRet = isPathName
  'ネットワーク先指定の場合、そのまま返却
  ElseIf ( _
    Left( _
      isPathName, _
      Len(csNetWorkString)) = csNetWorkString _
    ) Then
    lsRet = isPathName
  'カレント相対パスの場合のみ".\"を除去し当BOOKの格納パスを返却
  ElseIf (Left(isPathName, 2) = ".\") Then
    lsRet = _
      ThisWorkbook.Path & "\" & _
      Right(isPathName, Len(isPathName) - 2)
  '以外は、相対パス指定とみなし、絶対パスをつけて返却
  Else
    lsRet = ThisWorkbook.Path & "\" & isPathName
  End If

  'パスの最後の"\"付けに統一
  If (Right(lsRet, 1) <> "\") Then
    lsRet = lsRet & "\"
  End If

  updateRootPathForWin = lsRet

End Function

'# パス付ファイル名分離
'#    [戻り値]:
'#      String
'#        パス、またはファイル
'#    [引  数]:
'#      isFileNameIncPath(String)
'#        パス付のファイル名
'#      isLimitString(String)
'#        パスの区切り文字("\","/")
'#      iiType(Integer)
'#        1:パス名の返却要求
'#        2:ファイル名の返却要求
Private Function SplitFileIncPath( _
  isFileNameIncPath As String _
  , isLimitString As String _
  , iiType As Integer _
  ) As String

  Dim lsRet As String
  Dim liLoopCounter1 As Integer

  For liLoopCounter1 = Len(isFileNameIncPath) To 1 Step -1
    Dim lsSearchChar As String
    lsSearchChar = _
      Mid(isFileNameIncPath, liLoopCounter1, 1)
    If (lsSearchChar = isLimitString) Then
      Exit For
    End If
  Next liLoopCounter1

  If (iiType = 1) Then
    lsRet = Left(isFileNameIncPath, liLoopCounter1)
  Else
    lsRet = _
      Right( _
        isFileNameIncPath, _
        Len(isFileNameIncPath) - liLoopCounter1 _
      )
  End If

  SplitFileIncPath = lsRet

End Function

'#
'# ステータス取得
'#   [戻り値]:
'#     String
'#       CSV形式でプライベート変数内容を返却
'#   [引  数]:
'#     なし
'#
Public Function getStatus( _
  ) As String

  Dim lsRet As String

  lsRet = _
    "fbInitialize=" & fbInitialize & _
    ",lbNowOpenFile=" & lbNowOpenFile & _
    ",fsPathName=" & fsPathName & _
    ",fsFileName=" & fsFileName & _
    ",iFileNo=" & iFileNo

  getStatus = lsRet

End Function

'#
'# パス取得
'#   [戻り値]:
'#     String
'#   [引  数]:
'#     なし
'#
Public Function getPathName( _
  ) As String

  Dim lsRet As String

  lsRet = fsPathName

  getPathName = lsRet

End Function

'#
'# ファイル名取得
'#   [戻り値]:
'#     String
'#   [引  数]:
'#     なし
'#
Public Function getFileName( _
  ) As String

  Dim lsRet As String

  lsRet = fsFileName

  getFileName = lsRet

End Function

'#
'# ファイル存在チェック
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function isExist( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#ファイルが存在していること
  ElseIf (Dir(fsPathName & fsFileName, vbNormal) = "") Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
  End If

  isExist = lbRet

End Function

'#
'# ファイル削除
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function deleteFile( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#オープン済でないこと
  ElseIf (lbNowOpenFile <> False) Then
    lbRet = False
  'ファイルが存在していること
  ElseIf (Me.isExist() = False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    Kill fsPathName & fsFileName
    Me.Terminate
  End If

  deleteFile = lbRet

End Function

'#
'# ファイルオープン（読込用）
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function openFileForRead( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#オープン済でないこと
  ElseIf (lbNowOpenFile <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    iFileNo = FreeFile
    Open fsPathName & fsFileName For Output As #iFileNo
    lbNowOpenFile = True
  End If

  openFileForRead = lbRet

End Function

'#
'# ファイルオープン（上書用）
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function openFileForOutput( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#オープン済でないこと
  ElseIf (lbNowOpenFile <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    iFileNo = FreeFile
    Open fsPathName & fsFileName For Output As #iFileNo
    lbNowOpenFile = True
  End If

  openFileForOutput = lbRet

End Function

'#
'# ファイルオープン（追記用）
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function openFileForAppend( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#オープン済でないこと
  ElseIf (lbNowOpenFile <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    iFileNo = FreeFile
    Open fsPathName & fsFileName For Append As #iFileNo
    lbNowOpenFile = True
  End If

  openFileForAppend = lbRet

End Function

'#
'# ファイル書き込み
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     sBuf(String)
'#       書き込み文字列
'#
Public Function writeFileLine( _
  sBuf As String _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#オープン済であること
  ElseIf (lbNowOpenFile <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    Print #iFileNo, sBuf
  End If

  writeFileLine = lbRet

End Function

'#
'# ファイルクローズ
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function closeFile( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    '#オープン済であった場合クローズ
    If (lbNowOpenFile = True) Then
      Close #iFileNo
    End If
    iFileNo = 0
    lbNowOpenFile = False
  End If

  closeFile = lbRet

End Function
'#
'# 終了
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function Terminate( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    '#オープン済であった場合クローズ
    If (lbNowOpenFile = True) Then
      Me.closeFile
    End If
    Call clearField
  End If

  Terminate = lbRet

End Function

'#
'# デコンストラクタ
'#
Private Sub Class_Terminate()

  Set foExcelApplication = Nothing
  Call Me.Terminate

End Sub

'#
'# Excel終了時処理
'#
Private Sub foExcelApplication_WorkbookBeforeClose( _
  ByVal Wb As Workbook, Cancel As Boolean _
)

  Class_Terminate

End Sub

'#
'# フィールドクリア
'#
Private Sub clearField()
  
  fbInitialize = False
  fsPathName = ""
  fsFileName = ""
  lbNowOpenFile = False
  iFileNo = 0

End Sub