Temp_Module1

Option Explicit

Sub Main()
'-----------------------------------------
'各モジュールの呼び出し順序
'①checkBlankcell
'②fncIsExistsDir
'①GetSbfoleder
'②fncCheckPdfFileName
'③fncCheckExcelFileName
'③fncSheetExists
'④outputPDF
'-----------------------------------------
    Dim toolWb As Workbook
    Dim intMaxRow As Integer
    Dim intCount As Integer
   
    
    '空欄セルをチェック
    Call checkBlankCell
    
    If strBlankMsg <> "" Then
            MsgBox "以下のセルの空欄を入力してから再実行してください" & vbCrLf & strBlankMsg
            Exit Sub
    End If
    
     
     'マクロブックをワークブック変数に格納
    Set toolWb = ThisWorkbook
      
    'シートより親フォルダパを取得
    With Sheets(strMasterSheetName)
        strParentFolderPath = .Range(strParentFolderCell)
        Debug.Print "親フォルダパス：" & strParentFolderPath
    'シートより稟議フォルダパスを取得
        strRingiFolderPath = .Range(strRingiFolderCell)
        Debug.Print "稟議フォルダパス：" & strRingiFolderPath
    End With
    
    '親フォルダパスの存在確認
    If fncIsExistsDir(strParentFolderPath) = False Then
        MsgBox "派遣会社フォルダパスに指定されたフォルダは存在しません。" & vbCrLf & _
                "正しいパスを" & strParentFolderCell & "セルに入力しなおしてから再実行してください" & _
                vbCrLf & vbCrLf & strParentFolderPath
        Exit Sub
    End If
    
    '稟議フォルダパスの存在確認
    If fncIsExistsDir(strRingiFolderPath) = False Then
        MsgBox "稟議フォルダパスに指定されたフォルダは存在しません。" & vbCrLf & _
                "正しいパスを" & strRingiFolderCell & "セルに入力しなおしてから再実行してください" & _
                vbCrLf & vbCrLf & strRingiFolderPath
        Exit Sub
    End If
    
    '稟議ファイル有無結果をクリア
    Call 稟議ファイル有無結果クリア
    
    '一覧表をクリア
    Call 一覧表をクリア
    
    'エクセルファイルパスワードを入力
    strPassWord = InputBox("パスワード入力", "エクセルファイルのパスワードを入力してください。")
    If strPassWord = "" Then
        MsgBox "キャンセルします"
        Exit Sub
    End If
    
    '稟議番号ファイルの有無をチェック
    Call checkRingiFile
    
    'サブフォルダ一覧をSheet1に書き出し
    Call GetSubfolder(strParentFolderPath)
    
    'サブフォルダ内のファイルをサーチ
    With toolWb.Sheets(strToolSheetName)
    
        intMaxRow = .Cells(Rows.Count, intSubFolderColumn).End(xlUp).Row
        Debug.Print "最終行:" & intMaxRow
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        For intCount = intSubFolderStartRow To intMaxRow
        
            '----------------------------------------------------------
            '変数とフラグを初期化
            Call 初期化
            strSubFolderName = .Cells(intCount, intSubFolderColumn)
            Debug.Print vbCrLf & "フォルダ名" + strSubFolderName
            
            '-----------------------------------------------------------
            'PDFファイルの存在チェック
            
            'ファイル名に含まれる文言を取得
            strSeikyuNamePattern = Sheets(strConfigSheetName).Range(strSeikyuPdfNameCell)
            strMeisaiNamePattern = Sheets(strConfigSheetName).Range(strMeisaiPdfNameCell)
            
            'ファイル名のパターン（正規表現）を生成
            strSeikyuNamePattern = ".*" & strSeikyuNamePattern & ".*" & "\.pdf"
            strMeisaiNamePattern = ".*" & strMeisaiNamePattern & ".*" & "\.pdf"
            
            '請求書PDFと請求明細PDFの存在チェック
            blSeikyuPdfExists = fncCheckPdfFileName(strSubFolderName, strSeikyuNamePattern)
            blMeisaiPdfExists = fncCheckPdfFileName(strSubFolderName, strMeisaiNamePattern)
            
            Debug.Print "請求書pdf存在：" & blSeikyuPdfExists
            Debug.Print "請求明細書pdf存在：" & blMeisaiPdfExists
            
            '請求書PDFが存在しない場合はエラー文言設定しエラーフラグをtrueにする
            If blSeikyuPdfExists = False Then
                strErrMsg = "請求書PDFがありません"
                blErrFlag = True
            End If
            
            '------------------------------------------------------------
            '請求明細Excelの存在チェック
            
            '請求明細エクセルファイル名に含まれる文言を取得
            strMeisaiNamePattern = .Range(strMeisaiFileNameCell)
            
            '明細書PDFがない場合のみ明細書エクセルの存在有無を確認
            If blMeisaiPdfExists = False Then
                blMeisaiExcelExists = fncCheckExcelFileName(strSubFolderName, strMeisaiNamePattern)
            End If
            
            '明細エクセル有の場合はブックが既に開かれていないかチェック
            If blMeisaiExcelExists = True Then
               '対象ブックが開かれているかチェック
                blCheckBookOpened = IsBookOpened(strParentFolderPath & "\" & strSubFolderName & "\" & strMeisaiExcelPath)
                Debug.Print "明細エクセル開かれているか？：" & blCheckBookOpened
            End If
            
            'ブックが既に開かれていた場合はエラーメッセージを生成
            If blMeisaiPdfExists = False And blCheckBookOpened = True Then
'               'エラーメッセージを生成
                Call MakeErrMsg("請求明細PDFがありません/請求明細エクセルが開かれているため処理できませんでした")
                'エラーフラグを設定
                blErrFlag = True
            End If
            
            
            '明細書PDFなしかつ明細書エクセルなしの場合はエラー文言生成し、エラーフラグをTrueにする
            If blMeisaiPdfExists = False And blMeisaiExcelExists = False Then
'               'エラーメッセージを生成
                Call MakeErrMsg("請求明細PDFがありません/請求明細エクセルがありません")
                'エラーフラグを設定
                blErrFlag = True
            End If
            
            
            Debug.Print "請求明細xlsx存在：" & blMeisaiExcelExists
            
            '-------------------------------------------------------------
            '明細エクセルのシート名に含まれる文言を取得
            strMeisaiNamePattern = Sheets(strConfigSheetName).Range(strMeisaiSheetNameCell)
                        
            '明細書エクセルが存在する場合はシートの存在をチェック
            If blMeisaiPdfExists = False And blMeisaiExcelExists And blCheckBookOpened = False Then
                Debug.Print "請求明細書エクセルパス：" & strMeisaiExcelPath
                blMeisaiSheetExists = fncSheetExsists(strMeisaiExcelPath, strMeisaiNamePattern)
                Debug.Print "請求書明細書シート存在有無:" & blMeisaiSheetExists
            End If
            
            '明細書PDFなしかつ明細エクセルありかつ明細書エクセルシートなしの場合はエラー文言生成し、エラーフラグをTrueにする
            If blMeisaiPdfExists = False And blMeisaiExcelExists And blMeisaiSheetExists = False And blCheckBookOpened = False Then
                
                'エラーメッセージを生成
                Call MakeErrMsg("請求明細書PDFがありません" & vbCrLf & _
                            strMeisaiExcelPath & "に" & strMeisaiNamePattern & "を含むシート名が存在しません")
                'エラーフラグをTrueに設定
                blErrFlag = True
                
            End If
                        
            '----------------------------------------------------------------
 
            
            '請求明細書PDFの存在なし・かつ請求明細書シート有の場合は請求明細PDFを生成する
            
            '請求明細PDFに含まれる文言を取得
            strMeisaiNamePattern = Sheets(strConfigSheetName).Range(strMeisaiPdfNameCell)
            
            If blMeisaiPdfExists = False And blMeisaiSheetExists = True Then
                strMeisaiPdfPath = strParentFolderPath & "\" & strSubFolderName & "\【請求明細書】_" & strMeisaiNamePattern & "_" & strSubFolderName & ".pdf"
                strMeisaiExcelPath = strParentFolderPath & "\" & strSubFolderName & "\" & strMeisaiExcelPath
                Call outputPDF(strMeisaiExcelPath, strMeisaiPdfPath, strMeisaiSheetName)
            End If
            
            '出力結果を書込
            If blErrFlag Then
                .Cells(intCount, intOutputResultColumn) = "NG"
                .Cells(intCount, intCauseErrrColumn) = strErrMsg
            Else
                .Cells(intCount, intOutputResultColumn) = "OK"
            End If
    
        Next intCount
        
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        
    End With
    
    MsgBox "作業完了しました"

End Sub
Sub outputPDF(strExcelPath As String, strPdfPath As String, strTargetSheetName As String)
'------------------------------------------------
'機能：エクセルファイルをPDF変換する
'引数1：エクセルファイルパス
'引数2：変換後PDFファイルのパス
'引数3：PDF変換対象のエクセルシート名
'------------------------------------------------
    Dim wb As Workbook
    Dim strSheetName As String
    
    Debug.Print "変換前エクセルパス：" & strExcelPath
    Debug.Print "変換後PDFパス：" & strPdfPath
    
    
    
    'パスワードを解除してエクセルファイルを開く
    Set wb = Workbooks.Open(strExcelPath, Password:=strPassWord, WriteResPassword:=strPassWord)
    
        With wb.Sheets(strTargetSheetName).PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    
    wb.Sheets(strTargetSheetName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPdfPath
    wb.Close
    
    Set wb = Nothing
    
End Sub
Sub checkBlankCell()

    '変数と配列を初期化
    strBlankMsg = ""
    Erase arrayBlankCell
    
    Sheets(strMasterSheetName).Select
    
    If Sheets(strMasterSheetName).Range(strParentFolderCell) = "" Then
            arrayBlankCell(0) = strParentFolderCell & ":派遣会社フォルダパス"
    End If
    
    With Sheets(strConfigSheetName)
        
        If .Range(strSeikyuPdfNameCell) = "" Then
            arrayBlankCell(1) = strSeikyuPdfNameCell & "：請求書PDFファイル名に含まれる文言"
        End If
        
        If .Range(strMeisaiPdfNameCell) = "" Then
            arrayBlankCell(2) = strMeisaiPdfNameCell & "：明細書PDFファイル名に含まれる文言"
        End If
        
        If .Range(strMeisaiFileNameCell) = "" Then
            arrayBlankCell(3) = strMeisaiFileNameCell & "：明細書Excelファイル名に含まれる文言"
        End If
        
        If .Range(strMeisaiSheetNameCell) = "" Then
            arrayBlankCell(4) = strMeisaiSheetNameCell & "：明細書シート名に含まれる文言"
        End If
    
    End With
    
    Dim i As Integer
    
        For i = LBound(arrayBlankCell) To UBound(arrayBlankCell)
            If arrayBlankCell(i) <> "" Then
                strBlankMsg = strBlankMsg & arrayBlankCell(i) & vbCrLf
            End If
        Next
End Sub

Function fncIsExistsDir(targetPath As String) As Boolean
'----------------------------------------------------
'機能：指定されたフォルダパスが存在するか確認し
'　　　結果をTrueまたはFalseで返す
'引数1:フォルダパス
'-----------------------------------------------------
     With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(targetPath) Then
            fncIsExistsDir = True
        Else
            fncIsExistsDir = False
        End If
    End With
End Function

Sub GetSubfolder(strParentFolderPath As String)
'-------------------------------------------------------------------
'機能：親フォルダ内のサブフォルダを取得し、エクセルシートに書き出す

'引数1：親フォルダのパス
'-------------------------------------------------------------------
    Dim f As Object
    Dim i As Integer
    i = intSubFolderStartRow
    
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(strParentFolderPath).SubFolders
            Sheets(strToolSheetName).Cells(i, 3) = f.Name
            Debug.Print f.Name
            i = i + 1
        Next f
    End With
End Sub
Sub 初期化()
'-----------------------------
'機能：変数とフラグを初期化
'-----------------------------
    '各種パスの初期化
    strSeikyuPdfPath = ""
    strMeisaiPdfPath = ""
'    strSeikyuExcelPath = ""
    strMeisaiExcelPath = ""
    strSubFolderPath = ""
    strSubFolderName = ""
    
    '各種フラグの初期化
    blCreatePdf = False
    blSeikyuExcelExists = False
    blSeikyuPdfExists = False
    blSeikyuSheetExists = False
    blMeisaiPdfExists = False
    blMeisaiExcelExists = False
    blMeisaiSheetExists = False
    blErrFlag = False
    blCheckBookOpened = False
    
    'エラーメッセージの初期化
    strErrMsg = ""

End Sub
Function fncCheckPdfFileName(strFolderName As String, strPattern As String) As Boolean
'-----------------------------------------------------------------
'機能：ファイル名が指定された文字列パターンに該当するか確認する
'引数1：ファイル名の文字列
'引数2：一致確認したい文字列パターン
'----------------------------------------------------------------
    Dim blResult As Boolean
    Dim Filename As String
    Dim objReg As Object
'    Dim strFileType As String
    
    
    'RegExpをインスタンス化
    Set objReg = CreateObject("VBScript.RegExp")
        
        objReg.Global = True
        objReg.Pattern = strPattern
        
        'Dir関数の引数にワイルドカード含む引数設定 (最初のDir関数実行)
        Filename = Dir(strParentFolderPath & "\" & strFolderName & "\" & "*.pdf")

        'Dir関数の戻り値が空欄になるまで繰り返し
        Do While Filename <> ""
        
          'ファイル名がパターンに一致するかチェック
          fncCheckPdfFileName = objReg.test(Filename)
         
         'パターンが一致した場合、変数にファイルパスを格納
          If fncCheckPdfFileName Then
            Exit Do
          End If
          'Dir関数の引数を省略 （２回目以降引数省略でDir関数実行）
          Filename = Dir()
        Loop
        
        Set objReg = Nothing
        
End Function

Function fncCheckExcelFileName(strFolderName As String, strPattern As String) As Boolean
'-----------------------------------------------------------------
'機能：ファイル名が指定された文字列パターンに該当するか確認する
'引数1：ファイル名の文字列
'引数2：一致確認したい文字列パターン
'----------------------------------------------------------------
    Dim blResult As Boolean
    Dim Filename As String
    Dim objReg As Object
        
        'Dir関数の引数にワイルドカード含む引数設定 (最初のDir関数実行)
        Filename = Dir(strParentFolderPath & "\" & strFolderName & "\" & "*.xls*")

        'Dir関数の戻り値が空欄になるまで繰り返し
        Do While Filename <> ""
        
         'パターンが一致した場合、変数にファイルパスを格納
            If InStr(Filename, strPattern) > 0 Then
                    strMeisaiExcelPath = Filename
                    fncCheckExcelFileName = True
                Exit Do
            End If
         
          'Dir関数の引数を省略 （２回目以降引数省略でDir関数実行）
          Filename = Dir()
        Loop
        
        'ファイルが存在しない場合エラーメッセージを格納
'        If fncCheckExcelFileName = False And strErrMsg <> "" Then
'            strErrMsg = strErrMsg & vbCrLf
'        End If
        
        Set objReg = Nothing
        
End Function

Sub selectFolderPath()
  '------------------------------------------------------
  '機能：ダイアログを表示し、選択したフォルダのパスを返す
  '------------------------------------------------------
    Dim targetPath As String
    Dim objDialog As Object   'FileDialogオブジェクト格納用
    
    'FileDialogオブジェクトをインスタンス化
    Set objDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    'ダイアログを開いて選択したフォルダを親フォルダパスに指定
    If objDialog.Show Then
        targetPath = objDialog.SelectedItems(1)
        
        Sheets("Sheet1").Range("C3") = targetPath
    Else
        MsgBox "フォルダ選択キャンセル"
    End If
End Sub

Function fncSheetExsists(strpath As String, strPattern As String) As Boolean
'------------------------------------------------------------------------
'機能1：渡されたブックのシート全てを調べ、
'　　　 指定された文字列を含むシート名の有無を返す
'引数1：確認するブックを格納したワークブックオブジェクト
'引数2：マッチさせる文字列のパターン
'------------------------------------------------------------------------
    'シート名を初期化
'    shName = ""
    'フラグを初期化
    fncSheetExsists = False
'------------------------------------------------------
    Dim wb As Workbook
    Dim shCount As Integer
    Dim sh As Variant
    Dim objReg As Object
    Dim strShName As String
    Dim strFileType As String
    
    Debug.Print "対象ブックパス：" & strParentFolderPath & "\" & strSubFolderName & "\" & strpath
    
    '対象ブックが開かれているかチェック
'    blCheckBookOpened = IsBookOpened(strParentFolderPath & "\" & strSubFolderName & "\" & strpath)
    
    Debug.Print "フラグ :" & blCheckBookOpened
    
    'ブックが開かれていたらエラーメッセージを生成しプロシージャを抜ける
'    If blCheckBookOpened = True Then
'        Call MakeErrMsg("明細PDFなし/明細エクセルが開かれていたため処理できませんでした")
'        blErrFlag = True
'        Exit Function
'    End If
    
    Set wb = Workbooks.Open(strParentFolderPath & "\" & strSubFolderName & "\" & strpath, _
                            , Password:=strPassWord, WriteResPassword:=strPassWord)
    'ファイル内のシート数を取得
    shCount = wb.Sheets.Count
     
    '全シート分、該当シート名が見つかるまで繰り返し処理
    For Each sh In wb.Sheets
    
        'パターンが一致した場合、変数にファイルパスを格納して戻り値をTrueにセット
            If InStr(sh.Name, strPattern) > 0 Then
                strMeisaiSheetName = sh.Name
                fncSheetExsists = True
            Exit For
          End If
    Next
    
    'ブックを閉じて各オブジェクト変数を解放
    wb.Close
    Set wb = Nothing
    Set objReg = Nothing
    
End Function

Public Function IsBookOpened(ByVal FilePath As String) As Boolean
'-------------------------------------------------------------
'機能：ブックが既に開かれているか確認し、TrueかFlaseを返す
'引数1：対象ブックのパス
'-------------------------------------------------------------
  On Error Resume Next
     Open FilePath For Append As #1
     Close #1
     If Err.Number > 0 Then
       IsBookOpened = True
     End If
End Function
Sub MakeErrMsg(addMsg As String)
'----------------------------------------
'機能：エラー文言を生成する
'引数1：追加したいエラー文言
'----------------------------------------

    Debug.Print "strErrMsg：" & strErrMsg
    Debug.Print "addMsg ：" & addMsg

    If strErrMsg = "" Then
       strErrMsg = addMsg
    Else
        strErrMsg = strErrMsg & vbCrLf & addMsg
    End If
    
    Debug.Print "strErrMsg：" & strErrMsg

End Sub

Sub checkRingiFile()
'------------------------------------------
'稟議番号該当ファイルの有無をチェック
'------------------------------------------
    Dim intCount As Integer
    Dim intLastRow As Integer
    Dim arrayIndex As Integer
    Dim i As Integer
    Dim f As Object
    Dim blRingiFileExists As Boolean
    Dim strRingiErrMsg As String
    
    With Sheets(strConfigSheetName)
        intLastRow = .Cells(Rows.Count, intRingiNoColumn).End(xlUp).Row
        
        '設定シートに稟議番号の記載がない場合は処理しない
        If intLastRow = intRingiNoStartRow - 1 Then
            Call MakeErrMsg(strConfigSheetName & "に稟議番号の記載がないため判定不可")
            Exit Sub
        End If
        
        '配列のインデックスを初期値設定
        arrayIndex = 0
        
        '稟議番号を配列に格納
        For i = intRingiNoStartRow To intLastRow
            ReDim Preserve arrayRingiNo(arrayIndex)
            arrayRingiNo(arrayIndex) = .Cells(i, intRingiNoColumn)
            arrayIndex = arrayIndex + 1
        Next

        '稟議番号該当ファイルが存在するか稟議フォルダ内を検索
        With CreateObject("Scripting.FileSystemObject")
        
            '稟議番号配列をループ
            For i = LBound(arrayRingiNo) To UBound(arrayRingiNo)
            
                '稟議ファイル有無フラグの初期化
                blRingiFileExists = False
                
                'フォルダ内に稟議番号該当ファイルがあるか検索
                For Each f In .GetFolder(strRingiFolderPath).Files
                    If InStr(f.Name, arrayRingiNo(i)) > 0 Then
                        blRingiFileExists = True
                        Exit For
                    End If
                Next f
                
                '該当稟議番号ファイル無の場合、エラーメッセージを生成
                If blRingiFileExists = False Then
                    If strRingiErrMsg = "" Then
                        strRingiErrMsg = "稟議番号：" & arrayRingiNo(i) & "のPDFファイルがありません"
                    Else
                        strRingiErrMsg = strRingiErrMsg & vbCrLf & "稟議番号：" & arrayRingiNo(i) & "のPDFファイルがありません"
                    End If
                End If
                
                Debug.Print "稟議番号" & arrayRingiNo(i)
                Debug.Print "稟議有無フラグ" & blRingiFileExists
                Debug.Print "稟議エラーメッセージ："; strRingiErrMsg
                
            Next i
            
        End With
    
    End With
    
    '稟議番号有無結果をシートに書き出し
    With Sheets(strToolSheetName)
        If strRingiErrMsg <> "" Then
            
                .Range(strRingiNoReultCell) = "NG"
                .Range(strRingiNoCauseErrCell) = strRingiErrMsg
         Else
                .Range(strRingiNoReultCell) = "OK"
        End If
    End With
    
End Sub