' C_Const
Option Explicit

Public Const MASTER_A_DESTINATION_SHEET_NAME As String = "マスタA"
Public Const MASTER_B_DESTINATION_SHEET_NAME As String = "マスタB"
Public Const MASTER_C_DESTINATION_SHEET_NAME As String = "マスタC"

Public Function getWorkFolderPath() As String
    getWorkFolderPath = ThisWorkbook.Path & "\" & "作業用"
End Function

' E_Error
Option Explicit

' エラーNo
Public Enum eErrorType
    Unrecoverable = 2000 ' 外部要因によるプログラム続行不可エラー
    InvalidConfig = 2010   ' コンフィグの設定ミス
    ProgramBug = 2020    ' プログラムのバグ
End Enum

' throw メソッド
Public Sub RaiseUnrecoverableError(errorMessage As String)
    Call raise(eErrorType.Unrecoverable, errorMessage)
End Sub
Public Sub RaiseInvalidConfigError(errorMessage As String)
    Call raise(eErrorType.InvalidConfig, errorMessage)
End Sub
Public Sub RaiseProgramBugError(errorMessage As String)
    Call raise(eErrorType.ProgramBug, errorMessage)
End Sub

Private Sub raise(errorType As eErrorType, errorMessage As String)
    Err.raise errorType, "", errorMessage
End Sub

'P01_Main
Option Explicit

Public Sub entry()
    On Error GoTo 0
    Dim releaseDate As String
    releaseDate = getUserSelectedReleaseDate

On Error GoTo ExecError
    Dim toolWorkbook As workbook
    Call P02_Backup.createBackup(releaseDate)
    Set toolWorkbook = P03_ToolBookInitializer.initialize
    
    Call P04_ImportXXMaster.MasterAImport(toolWorkbook, releaseDate)
    ' P05
    ' P06
    Call MsgBox("", vbOKOnly, "処理が完了しました")
    Exit Sub

ExecError:
    Call MsgBox(Err.Description, vbCritical & vbOKOnly)
End Sub

' ユーザーが選択したリリース日を取得する
Private Function getUserSelectedReleaseDate() As String
    Const message As String = "どっち"
    
    Dim userAnswer As Long
    userAnswer = MsgBox(message, vbYesNo, "ツールのリリース日を選択してください")
    
    Dim releaseDate As String
    If (userAnswer = vbYes) Then
        releaseDate = Format(DateAdd("m", 1, Date), "YYYYMM") & "01"
    Else
        releaseDate = Format(Date, "YYYYMMDD")
    End If
    
    getUserSelectedReleaseDate = releaseDate
End Function


'P02_Backup
Option Explicit

' バックアップ・作業用フォルダに最新のツールを格納する
Public Sub createBackup(releaseDate As String)
    Dim toolName As String
    toolName = U_Config.getValue(eConfigKey.toolName)
    Dim releaseFolderPath As String
    releaseFolderPath = U_Config.getValue(eConfigKey.releaseFolder)
    Dim backupFolderPath As String
    backupFolderPath = U_Config.getValue(eConfigKey.backupFolder)
    Dim workFolderPath As String
    workFolderPath = C_Const.getWorkFolderPath

    ' 作業用フォルダをクリアする
    Call clearWorkFolder(workFolderPath, toolName)
    
    ' 最新のツールを取得する
    Dim latestToolFile As File
    Set latestToolFile = findLatestToolFile(releaseFolderPath, toolName)
    
    ' バックアップフォルダにツールをコピーする
    Call copyToBackupFolder(latestToolFile, backupFolderPath)
    
    ' 作業用フォルダーにツールをコピーする
    Call copyToWorkFolder(latestToolFile, workFolderPath, toolName, releaseDate)
End Sub

' 作業用フォルダをクリアする
Private Sub clearWorkFolder(folderPath As String, fileName As String)
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    ' 作業用フォルダが存在する場合
    If (fso.FolderExists(folderPath)) Then
        Dim matchedFiles As Collection
        Set matchedFiles = U_File.findFilesByName(folderPath, fileName)
        
        Dim f As File
        For Each f In matchedFiles
            On Error GoTo FileDeleteFailed
            Call f.Delete(True)
            On Error GoTo 0
        Next
    Else
        fso.CreateFolder (folderPath)
    End If
    Exit Sub

FileDeleteFailed:
    Call E_Error.RaiseUnrecoverableError( _
        "作業フォルダのファイルが開かれているため、ファイルの削除に失敗しました。" & vbCrLf _
            & "作業フォルダ内のすべてのファイルを閉じてから再試行してください。" & vbCrLf & vbCrLf _
            & "[フォルダ] " & vbCrLf & folderPath)
End Sub

' 最新のツールファイルを取得する
Private Function findLatestToolFile(folderPath As String, toolName As String) As File
    Dim latestToolFile As File
    Set latestToolFile = U_File.findSingleFileByName(folderPath, toolName)

    Set findLatestToolFile = latestToolFile
End Function

' バックアップフォルダに最新のファイルをコピーする
Private Sub copyToBackupFolder(toolFile As File, folderPath As String)
    Dim fullpath As String
    fullpath = U_File.joinPath(folderPath, toolFile.Name)

    Call FileCopy(toolFile.Path, fullpath)
End Sub

' 作業用フォルダに最新ファイルをコピーする
Private Sub copyToWorkFolder(toolFile As File, folderPath As String, toolName As String, releaseDate As String)
    Dim fileName As String
    fileName = toolName & "_" & releaseDate & ".xlsm"
    Dim fullpath As String
    fullpath = U_File.joinPath(folderPath, fileName)
    
    Call FileCopy(toolFile.Path, fullpath)
End Sub


'P03_ToolBookInitializeer
Option Explicit

' インポートの事前処理を行う
Public Function initialize() As workbook
    Dim workFolderPath As String
    workFolderPath = C_Const.getWorkFolderPath
    Dim toolName As String
    toolName = U_Config.getValue(eConfigKey.toolName)
    
    ' ツールのブックを開く
    Dim toolBook As workbook
    Set toolBook = openWorkBook(workFolderPath, toolName)

    ' 処理対象のシートを取得する
    Dim targetSheetNames As Collection
    Set targetSheetNames = New Collection
    Call targetSheetNames.Add(C_Const.MASTER_A_DESTINATION_SHEET_NAME)
    Call targetSheetNames.Add(C_Const.MASTER_B_DESTINATION_SHEET_NAME)
    Call targetSheetNames.Add(C_Const.MASTER_C_DESTINATION_SHEET_NAME)

    ' パスワードを解除する
    Call unprotectSheets(toolBook, targetSheetNames)
    
    ' セル値を可視化する
    Call visibleSheetsValue(toolBook, targetSheetNames)
    
    Set initialize = toolBook
End Function

Private Function openWorkBook(workFolderPath As String, toolName As String) As workbook
    Dim toolFile As File
    Set toolFile = U_File.findSingleFileByName(workFolderPath, toolName)
    
    Dim wb As workbook
    Set wb = Workbooks.Open(toolFile.Path)
    Set openWorkBook = wb
End Function

' 各シートの保護を解除する
Private Sub unprotectSheets(wb As workbook, worksheetNames As Collection)
    ' パスワード不一致回数
    Dim passwordMismatchCount As Long
    passwordMismatchCount = 0
    
    Dim ws As Worksheet
    Set ws = U_Book.getWorksheet(wb, worksheetNames.Item(1))

PasswordInput:
    ' パスワードをアンロックする
    Dim inputPassword As String
    inputPassword = InputBox("パスワードを入力してください。", "パスワード入力")
    On Error GoTo PasswordMismatch:
        Call ws.Unprotect(inputPassword)
    On Error GoTo 0
    GoTo UnlockSucceed
    
' パスワード不一致
PasswordMismatch:
    passwordMismatchCount = passwordMismatchCount + 1
    If (passwordMismatchCount < 3) Then
        Call MsgBox("パスワードが違います。再度入力をしてください", vbOKOnly & vbCritical)
        Resume PasswordInput
    ElseIf (passwordMismatchCount = 3) Then
        Call E_Error.RaiseUnrecoverableError("パスワードの解除に失敗しました。処理を中断します。")
        Exit Sub
    End If

UnlockSucceed:
    ' 2シート目以降のパスワードを解除
    Dim i As Long
    For i = 2 To worksheetNames.Count
        Set ws = U_Book.getWorksheet(wb, worksheetNames.Item(i))
        Call ws.Unprotect(inputPassword)
    Next
    
    Call MsgBox("パスワードの解除に成功しました。", vbOKOnly & vbInformation, "パスワード解除")
End Sub

' セル値を可視化する
Private Sub visibleSheetsValue(wb As workbook, worksheetNames As Collection)
    Dim i As Long
    Dim ws As Worksheet
    For i = 1 To worksheetNames.Count
        Set ws = U_Book.getWorksheet(wb, worksheetNames.Item(i))
        ws.Cells.Interior.ColorIndex = xlNone
        ws.Cells.Font.Color = RGB(0, 128, 128)
    Next
End Sub

' P04_ImportXXMaster
Option Explicit

' マスタAをインポートする
Public Sub MasterAImport(toolBook As workbook, releaseDate As String)
    On Error GoTo AnyError

    ' マスタファイルを開く
    Dim masterStoredFolderPath As String
    masterStoredFolderPath = U_Config.getValue(eConfigKey.MasterAStoredFolder)
    Dim masterFileName As String
    masterFileName = U_Config.getValue(eConfigKey.MasterABookName)
    Dim masterBook As workbook
    Set masterBook = openMasterBook(masterStoredFolderPath, masterFileName, releaseDate)
        
    ' 対象シートを取得する
    Dim sourceSheetName As String
    sourceSheetName = U_Config.getValue(eConfigKey.MasterASourceSheetName)
    Dim sourceSheet As Worksheet
    Set sourceSheet = U_Book.getWorksheet(masterBook, sourceSheetName)
    
    ' インポートを行う
    Dim destinationSheet As Worksheet
    Dim sourceAddress As String
    Dim destinationAddress As String
    Set destinationSheet = toolBook.worksheets(C_Const.MASTER_A_DESTINATION_SHEET_NAME)
    sourceAddress = U_Config.getValue(eConfigKey.MasterASourceAddress)
    destinationAddress = U_Config.getValue(eConfigKey.MasterADestinationAddress)
    Call import(sourceSheet, sourceAddress, destinationSheet, destinationAddress)
    
    ' マスタファイルを閉じる
    Call U_ExcelBook.closeWorkbookSafety(masterBook, False)
    Exit Sub

AnyError:
    Dim tempErrNo As Long
    Dim tempErrDescription As String
    tempErrNo = Err.Number
    tempErrDescription = Err.Description
    Call U_Book.closeWorkbookSafety(masterBook, False)

    Call Err.raise(tempErrNo, , tempErrDescription)
End Sub

' マスタファイルを開く
Private Function openMasterBook(masterFolderPath As String, masterFileName As String, toolReleaseDate As String) As workbook
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    ' マスタファイルを取得する
    Dim masterFile As File
    Set masterFile = U_File.findSingleFileByName(masterFolderPath, masterFileName)
    
    ' ファイル名の更新日をチェックする
    Dim masterUpdatedDate As String
    masterUpdatedDate = Right(fso.GetBaseName(masterFile.Path), 8)
    masterUpdatedDate = Left(masterUpdatedDate, 6)
    Dim expectedUpdateDate As String
    expectedUpdateDate = Left(toolReleaseDate, 6)

    If (masterUpdatedDate <> expectedUpdateDate) Then
        Dim errorMessage As String
        errorMessage = "対象マスタのファイル名の更新月がツールのリリース月と一致しません。" & vbCrLf & vbCrLf _
                                     & "[期待値] " & expectedUpdateDate & vbCrLf _
                                     & "[実際値] " & masterUpdatedDate & vbCrLf & vbCrLf _
                                     & "[ファイルパス] " & vbCrLf & masterFile.Path & vbCrLf
        Call E_Error.RaiseUnrecoverableError(errorMessage)
    End If
    
    ' マスタファイルを開く
    On Error GoTo WorkBookOpenFailed
    Dim wb As workbook
    Set wb = Workbooks.Open(masterFile.Path, ReadOnly:=True)
    Set openMasterBook = wb
    On Error GoTo 0
    
    Exit Function
    
WorkBookOpenFailed:
    Call E_Error.RaiseUnrecoverableError("マスタファイルを開くことができませんでした。" & vbCrLf & vbCrLf _
                                                                    & "[ファイルパス] " & vbCrLf & masterFile.Path)
End Function

' インポートを行う
Private Sub import(sourceSheet As Worksheet _
                                        , sourceAddress As String _
                                        , destinationSheet As Worksheet _
                                        , destinationAddress As String)
    Dim source As range
    Dim destination As range
    Set source = sourceSheet.range(sourceAddress)
    Set destination = destinationSheet.range(destinationAddress)
    
    Dim sourceHeader As range
    Dim destinationHeader As range
    Set sourceHeader = source.Rows(1).Cells
    Set destinationHeader = destination.Rows(1).Cells
    
    ' ヘッダーをチェックする
    Call validateHeader(sourceHeader, destinationHeader)
    
    ' 終端行を取得する
    Dim lastRow As Long
    lastRow = getLastRow(source)
    
    ' 値をインポートする
    Call destinationSheet.Cells.ClearContents
    destinationSheet.Cells.NumberFormatLocal = "@"

    ' 値をコピーする
    destination.Resize(lastRow - 1).Value = source.Resize(lastRow - 1).Value
End Sub

' インポート元／先でヘッダーの定義が一致することを確認する
Private Sub validateHeader(sourceHeader As range, destinationHeader As range)

    ' 列数が一致するか
    If (sourceHeader.Cells.Count <> destinationHeader.Cells.Count) Then
        Call E_Error.RaiseUnrecoverableError("ヘッダーの列数が一致しません" & vbCrLf & vbCrLf _
                                            & "[インポート元] " & sourceHeader.Cells.Count & " 列" & vbCrLf _
                                            & "[インポート先] " & destinationHeader.Cells.Count & " 列")
    End If

    ' ヘッダー名が一致するか
    Dim i As Long
    For i = 1 To sourceHeader.Cells.Count
        Dim sourceHeaderName As String
        Dim destinationHeaderName As String
        sourceHeaderName = Trim(sourceHeader.Cells(1, i).Value)
        destinationHeaderName = Trim(destinationHeader.Cells(1, i).Value)
        
        If (sourceHeaderName <> destinationHeaderName) Then
            Call E_Error.RaiseUnrecoverableError("インポート元とインポート先で" & i & "番目のヘッダー名が異なります" & vbCrLf _
                                                & "[列番号] " & i & vbCrLf _
                                                & "[インポート元] " & sourceHeaderName & vbCrLf _
                                                & "[インポート先] " & destinationHeaderName)
        End If
    Next
End Sub

' 終端行を取得する
' 指定列範囲のうち、最も下側に値が入っている行を終端とする
Private Function getLastRow(range As range) As Long
    Dim header As range
    Set header = range.Rows(1)
    
    Dim maxLastRow As Long
    maxLastRow = -1
    
    Dim ws As Worksheet
    Set ws = range.Worksheet
    
    Dim cell As range
    For Each cell In header.Cells
        Dim currentLastRow As Long
        currentLastRow = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
        If (maxLastRow < currentLastRow) Then 
            maxLastRow = currentLastRow 
        End If 
    Next 
    getLastRow = maxLastRow 
End Function 

' U_Book
Option Explicit

' シートを取得する
Public Function getWorksheet(wb As workbook, sheetName As String) As Worksheet
    If (wb Is Nothing) Then
        E_Error.RaiseProgramBugError ( _
            "ブックが開かれていないため、シートの取得に失敗しました。" & vbCrLf & vbCrLf _
                    & "[シート名] " & sheetName)
    End If
    
    Dim ws As Worksheet
    On Error GoTo WorksheetNotFound
    Set ws = wb.worksheets(sheetName)
    Set getWorksheet = ws
    Exit Function

WorksheetNotFound:
    E_Error.RaiseUnrecoverableError ( _
        "ブック中に指定の名前を持つシートが存在しません。" & vbCrLf & vbCrLf _
                & "[ファイル名] " & wb.Name & vbCrLf _
                & "[シート名] " & sheetName)
End Function

' ブックを閉じる
Public Sub closeWorkbookSafety(wb As workbook, isSave As Boolean)
    If Not (wb Is Nothing) Then
        On Error Resume Next
        Call wb.Close(isSave)
        On Error GoTo 0
    End If
End Sub


' U_Config
Option Explicit

Private Const SHEET_NAME As String = "定義"

Private Const CONFIG_BEGIN_ROW As Long = 3
Private Const CONFIG_KEY_COLUMN As Long = 1
Private Const CONFIG_VALUE_COLUMN As Long = 2

' キー名
Public Enum eConfigKey
    backupFolder = 1
    releaseFolder
    toolName
    MasterAStoredFolder
    MasterABookName
    MasterASourceSheetName
    MasterASourceAddress
    MasterADestinationAddress
    
    MasterBStoredFolder
    MasterBBookName
    MasterBImportSheetName
    MasterCStoredFolder
    MasterCBookName
    MasterCImportSheetName
End Enum

' コンフィグの値を取得する
Public Function getValue(key As eConfigKey)
    Dim japaneseKeyName As String
    japaneseKeyName = convertKeyToJapanese(key)
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.worksheets(SHEET_NAME)
    Dim lastRow As Long
    lastRow = ws.Cells(Rows.Count, CONFIG_KEY_COLUMN).End(xlUp).Row
    
    Dim i As Long
    For i = CONFIG_BEGIN_ROW To lastRow
        If (ws.Cells(i, CONFIG_KEY_COLUMN) = japaneseKeyName) Then
            getValue = ws.Cells(i, CONFIG_VALUE_COLUMN)
            Exit Function
        End If
    Next

    Call E_Error.RaiseInvalidConfigError( _
        "パラメータが定義されていません。" & vbCrLf _
            & "パラメータキー名：" & japaneseKeyName)
End Function

' コンフィグキー名に対応する日本語キー名を取得する
Private Function convertKeyToJapanese(key As eConfigKey) As String
    Dim dic As Dictionary
    Set dic = New Dictionary
    
    Call dic.Add(eConfigKey.backupFolder, "バックアップフォルダ")
    Call dic.Add(eConfigKey.releaseFolder, "リリースフォルダ")
    Call dic.Add(eConfigKey.toolName, "ツール名")
    
    Call dic.Add(eConfigKey.MasterABookName, "マスタAファイル名")
    Call dic.Add(eConfigKey.MasterAStoredFolder, "マスタA格納フォルダパス")
    Call dic.Add(eConfigKey.MasterASourceSheetName, "マスタAインポート元シート名")
    Call dic.Add(eConfigKey.MasterASourceAddress, "マスタAインポート元範囲")
    Call dic.Add(eConfigKey.MasterADestinationAddress, "マスタAインポート先範囲")
    
    Call dic.Add(eConfigKey.MasterBStoredFolder, "マスタB格納フォルダパス")
    Call dic.Add(eConfigKey.MasterBBookName, "マスタBファイル名")
    Call dic.Add(eConfigKey.MasterBImportSheetName, "マスタBシート名")
    Call dic.Add(eConfigKey.MasterCStoredFolder, "マスタC格納フォルダパス")
    Call dic.Add(eConfigKey.MasterCBookName, "マスタCファイル名")
    Call dic.Add(eConfigKey.MasterCImportSheetName, "マスタCシート名")

    If Not (dic.Exists(key)) Then
        Call E_Error.RaiseProgramBugError( _
            "configKeyに存在しないキー値が渡されました。" & vbCrLf _
                & "キー値：" & key)
    End If

    convertKeyToJapanese = dic.Item(key)
End Function

' U_File
Option Explicit

' パスを結合する
Public Function joinPath(path1 As String, path2 As String) As String
    joinPath = path1 & "/" & path2
End Function

' フォルダ内のファイル名の一致するすべてのファイルを取得する
Public Function findFilesByName(folderPath As String, fileName As String) As Collection
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim targetFolder As Folder
    ' フォルダが存在しない場合
    If Not fso.FolderExists(folderPath) Then
        Call E_Error.RaiseUnrecoverableError( _
            "指定されたパスが存在しません。" & vbCrLf & vbCrLf _
                & "[フォルダパス]" & vbCrLf & folderPath)
    End If
    
    Set targetFolder = fso.GetFolder(folderPath)
    Dim regex As RegExp
    Set regex = New RegExp
    regex.Pattern = fileName
    
    Dim matchedFiles As Collection
    Set matchedFiles = New Collection
    Dim f As File
    For Each f In targetFolder.files
        If (regex.test(f.Name)) Then
            ' 隠しファイルでなければ
            ' 0x0010 : 2 → 隠しファイル属性
            If ((f.Attributes And 2) = 0) Then
                Call matchedFiles.Add(f)
            End If
        End If
    Next
    
    Set findFilesByName = matchedFiles
End Function

' フォルダ内のファイル名が一致するファイルを取得する
' 一致するファイルが0 または2以上である場合、例外を送出する
Public Function findSingleFileByName(filePath As String, fileName As String) As File
    Dim files As Collection
    Set files = findFilesByName(filePath, fileName)
    
    If (files.Count = 0) Then
        Call E_Error.RaiseUnrecoverableError( _
            "指定されたフォルダ内にファイルが存在しません。" & vbCrLf & vbCrLf _
                & "[フォルダ]" & vbCrLf & filePath & vbCrLf _
                & "[検索ファイル名]" & vbCrLf & fileName)
    ElseIf (files.Count >= 2) Then
        Dim joinedFileNames As String
        Dim f As File
        For Each f In files
            joinedFileNames = joinedFileNames & f.Name & vbCrLf
        Next
        Call E_Error.RaiseUnrecoverableError( _
            "指定されたフォルダにファイルが複数存在します。" & vbCrLf & vbCrLf _
                & "[フォルダパス]" & vbCrLf & filePath & vbCrLf _
                & "[ファイル名]" & vbCrLf & joinedFileNames)
    End If
    
    Set findSingleFileByName = files.Item(1)
End Function