VBAを使ってフォルダを読込

vba

Sub ProcessLogFiles()
    Dim fso As Object
    Dim rootFolder As Object
    Dim serverFolder As Object
    Dim rootPath As String
    Dim serverName As String
    Dim newWorkbook As Workbook
    Dim logFiles As Collection
    
    ' ユーザーにルートディレクトリを選択させる
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "ルートディレクトリを選択"
        If .Show <> -1 Then Exit Sub
        rootPath = .SelectedItems(1)
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rootFolder = fso.GetFolder(rootPath)
    
    ' 各サーバーフォルダを巡回処理
    For Each serverFolder In rootFolder.SubFolders
        serverName = serverFolder.Name
        Set logFiles = New Collection
        
        ' 全ての.logファイルを収集（サブディレクトリ含む）
        CollectLogFiles fso, serverFolder, logFiles
        
        If logFiles.Count > 0 Then
            Application.DisplayAlerts = False
            Set newWorkbook = Workbooks.Add
            ProcessLogContent fso, newWorkbook, logFiles
            SaveWorkbook fso, newWorkbook, rootPath, serverName
            Application.DisplayAlerts = True
        End If
    Next serverFolder
    
    MsgBox "処理が完了しました！"
    Set fso = Nothing
End Sub

' ログファイルを再帰的に収集するサブルーチン
Sub CollectLogFiles(fso As Object, folder As Object, ByRef logFiles As Collection)
    Dim file As Object
    Dim subFolder As Object
    
    ' カレントフォルダの.logファイルを追加
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "log" Then
            logFiles.Add file
        End If
    Next file
    
    ' サブフォルダを再帰処理
    For Each subFolder In folder.SubFolders
        CollectLogFiles fso, subFolder, logFiles
    Next subFolder
End Sub

' ログ内容を処理してワークブックに書き込む
Sub ProcessLogContent(fso As Object, wb As Workbook, logFiles As Collection)
    Dim ws As Worksheet
    Dim currentRow As Long
    Dim file As Object
    Dim filePath As String
    
    Set ws = wb.Sheets(1)
    currentRow = 1
    
    For Each file In logFiles
        filePath = file.Path
        With ws
            ' ファイル名ヘッダーを書き込み
            .Cells(currentRow, 1).Value = "ファイル: " & file.Name
            currentRow = currentRow + 1
            
            ' ファイル内容を書き込み
            currentRow = WriteLogContent(fso, filePath, ws, currentRow)
            
            ' 空行で区切りを追加
            currentRow = currentRow + 1
        End With
    Next file
    
    ' 列幅を自動調整
    ws.Columns(1).AutoFit
End Sub

' ログファイルの内容をワークシートに書き込む関数
Function WriteLogContent(fso As Object, filePath As String, ws As Worksheet, startRow As Long) As Long
    Dim stream As Object
    Dim line As String
    Dim currentRow As Long
    
    ' ADODB.Streamを使用してUTF-8エンコードファイルを処理
    Set stream = CreateObject("ADODB.Stream")
    stream.Charset = "utf-8"
    stream.Open
    stream.LoadFromFile filePath
    
    currentRow = startRow
    Do Until stream.EOS
        line = stream.ReadText(-2)  ' -2は行単位読み取りを指定
        If Trim(line) <> "" Then
            ws.Cells(currentRow, 1).Value = line
            currentRow = currentRow + 1
        End If
    Loop
    
    stream.Close
    WriteLogContent = currentRow
End Function

' ワークブックを保存するサブルーチン
Sub SaveWorkbook(fso As Object, wb As Workbook, rootPath As String, serverName As String)
    Dim savePath As String
    savePath = fso.BuildPath(rootPath, serverName & ".xlsx")
    
    ' 既存ファイルを削除
    If fso.FileExists(savePath) Then
        fso.DeleteFile savePath
    End If
    
    ' 新規ファイルとして保存
    wb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
    wb.Close SaveChanges:=False
End Sub