notesscript

Sub ProcessExcelFiles()
    Dim ws As New NotesUIWorkspace
    Dim dialog As NotesUIDialog
    Dim filePath As String
    Dim fileName As String
    Dim parentFolder As String
    Dim parentFolderName As String
    Dim excelApp As Variant
    Dim workBook As Variant
    Dim sheet As Variant
    Dim workFile As Variant
    Dim workSheet As Variant
    Dim cellValue As String
    Dim regExp As Variant
    Dim parentDir As String
    Dim folder As Variant
    Dim file As Variant
    Dim targetFolder As String
    Dim targetFile As String
    Dim workBookNew As Variant
    Dim sheetNew As Variant
    Dim rowIndex As Integer
    Dim filterRange As Variant
    Dim cell As Variant
    
    ' --- ① ファイル選択ダイアログ ---
    filePath = ws.OpenFileDialog(False, "Excelファイルを選択してください", "Excelファイル|*.xlsx")
    If filePath = "" Then
        Messagebox "ファイルが選択されていません", 16, "エラー"
        Exit Sub
    End If

    ' --- ② A1セルの確認 ---
    Set excelApp = CreateObject("Excel.Application")
    Set workBook = excelApp.Workbooks.Open(filePath)
    Set sheet = workBook.Sheets("A")

    cellValue = sheet.Cells(1, 1).Value
    If cellValue <> "2025" Then
        Messagebox "A1セルが'2025'ではありません", 16, "エラー"
        workBook.Close False
        excelApp.Quit
        Exit Sub
    End If

    ' --- ③ 親フォルダ名の確認 ---
    parentFolder = Mid(filePath, 1, InstrRev(filePath, "\") - 1)
    parentFolderName = Mid(parentFolder, InstrRev(parentFolder, "\") + 1)

    Set regExp = CreateObject("VBScript.RegExp")
    regExp.Pattern = "^\d{4}年$"
    If Not regExp.Test(parentFolderName) Then
        Messagebox "親フォルダ名が'数値4桁+年'ではありません", 16, "エラー"
        workBook.Close False
        excelApp.Quit
        Exit Sub
    End If

    ' --- ④ c:\temp\Work.xlsx 作成 ---
    targetFile = "C:\temp\Work.xlsx"
    Set workBookNew = excelApp.Workbooks.Add
    workBookNew.SaveAs targetFile

    ' --- ⑤ フォルダ内の全ExcelファイルのBシートB1セルをコピー ---
    Set workSheet = workBookNew.Sheets(1)
    rowIndex = 1

    Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(parentFolder)
    For Each file In folder.Files
        If LCase(Right(file.Name, 5)) = ".xlsx" Then
            Set workBook = excelApp.Workbooks.Open(file.Path)
            Set sheet = workBook.Sheets("B")
            workSheet.Cells(rowIndex, 1).Value = sheet.Cells(1, 2).Value
            workBook.Close False
            rowIndex = rowIndex + 1
        End If
    Next

    ' --- ⑥ 同列の他のフォルダのデータも追加 ---
    parentDir = Mid(parentFolder, 1, InstrRev(parentFolder, "\") - 1)
    Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(parentDir)

    For Each targetFolder In folder.SubFolders
        If regExp.Test(targetFolder.Name) And targetFolder.Path <> parentFolder Then
            For Each file In targetFolder.Files
                If LCase(Right(file.Name, 5)) = ".xlsx" Then
                    Set workBook = excelApp.Workbooks.Open(file.Path)
                    Set sheet = workBook.Sheets("B")
                    workSheet.Cells(rowIndex, 1).Value = sheet.Cells(1, 2).Value
                    workBook.Close False
                    rowIndex = rowIndex + 1
                End If
            Next
        End If
    Next

    ' --- ⑦ A-Z列にフィルターを設定 ---
    Set filterRange = workSheet.Range("A1:Z" & rowIndex - 1)
    filterRange.AutoFilter

    ' --- ⑧ A列が「K-xxxx」である行を取得 ---
    rowIndex = 1
    While workSheet.Cells(rowIndex, 1).Value <> ""
        If Left(workSheet.Cells(rowIndex, 1).Value, 2) = "K-" Then
            Debug.Print "K-xxxxの行: " & rowIndex
        End If
        rowIndex = rowIndex + 1
    Wend

    ' --- 後処理 ---
    workBookNew.Save
    workBookNew.Close
    excelApp.Quit

    Messagebox "処理が完了しました", 64, "完了"
End Sub