【事前準備はCLIコマンドだけ】AWSリソース情報をExcelに取り込んでくれるツール作ってみた

aws ec2 describe-instances --profile PROFILE_NAME --query 'Reservations[].Instances[].{Name: Tags[?Key==Name].Value|[0], InstanceId: InstanceId, PlatformDetails: PlatformDetails, InstanceType:InstanceType, LaunchTime: LaunchTime }' >ec2ListPrd.json

Sub RunPowerShellCommand()
     Dim objShell As Object
     Set objShell = CreateObject("WScript.Shell")
     ' ベースパスを設定
     Dim basePath As String
     basePath = ThisWorkbook.Path & "\\"
     ' シート「CLI」のA列のコマンドを取得
     Dim ws As Worksheet
     Set ws = ThisWorkbook.Worksheets("CLI")
     Dim cmd As Range
     Set cmd = ws.Range("A1")
     ' シート「Profile」からプロファイル名を取得
     Dim profileWs As Worksheet
     Set profileWs = ThisWorkbook.Worksheets("Profile")
     Dim profileName As String
     profileName = profileWs.Range("A2").Value
     ' 空白のセルに行き当たるまでコマンドを順番に実行
     Do While Not cmd Is Nothing And cmd.Value <> ""
         Dim cmdString As String
         cmdString = cmd.Value
         cmdString = Replace(cmdString, "PROFILE_NAME", profileName)
         Dim strCommand As String
         strCommand = "powershell.exe -Command ""& {cd '" & basePath & "data' ; " & cmdString & "}"""
         'コマンドを実行する
         objShell.Run strCommand, 0, True
         Set cmd = cmd.Offset(1, 0) ' 次の行に進む
         If cmd.Value = "" Then Exit Do ' 空白の場合ループを抜ける
     Loop
     ' 完了メッセージを表示
     MsgBox "CLIコマンドの実行が完了しました。"
     Set objShell = Nothing
 End Sub
 Sub UpdateOrImportJsonFiles()
     Dim currentDir As String
     Dim dataFolder As String
     Dim jsonFiles As Collection
     Dim queryName As String
     Dim ws As Worksheet
     Dim found As Boolean
     ' current_directoryシートのA2セルからExcelファイルが存在するフォルダのパスを取得
     Set ws = ThisWorkbook.Sheets("current_directory")
     currentDir = ws.Range("A2").Value
     dataFolder = currentDir & "data\\"
     ' JSONファイルのリストを取得
     Set jsonFiles = GetFiles(dataFolder, "*.json")
     ' 各JSONファイルを処理
     For Each jsonFile In jsonFiles
         queryName = Replace(jsonFile, ".json", "")
         found = False
         ' 既存のパワークエリを確認し、更新する
         On Error Resume Next
         found = Not ThisWorkbook.Queries(queryName) Is Nothing
         On Error GoTo 0
         If found Then
             ' クエリを更新
             RefreshQuery queryName
         Else
             ' 新しいクエリを追加
             AddNewQuery queryName, dataFolder & jsonFile
         End If
     Next jsonFile
 End Sub
 ' 指定されたフォルダ内のファイルを取得する関数
 Function GetFiles(folderPath As String, filePattern As String) As Collection
     Dim fileSystem As Object
     Dim folder As Object
     Dim file As Object
     Dim files As New Collection
     Set fileSystem = CreateObject("Scripting.FileSystemObject")
     Set folder = fileSystem.GetFolder(folderPath)
     For Each file In folder.files
         If LCase(file.Name) Like LCase(filePattern) Then
             files.Add file.Name
         End If
     Next file
     Set GetFiles = files
 End Function
 ' クエリを更新するサブルーチン
 Sub RefreshQuery(queryName As String)
     Dim ws As Worksheet
     Dim lo As ListObject
     On Error Resume Next
     For Each ws In ThisWorkbook.Worksheets
         For Each lo In ws.ListObjects
             If lo.SourceType = xlSrcQuery Then
                 If lo.QueryTable.CommandText(1) = "SELECT * FROM [" & queryName & "]" Then
                     lo.QueryTable.Refresh BackgroundQuery:=False
                     Exit Sub
                 End If
             End If
         Next lo
     Next ws
     On Error GoTo 0
 End Sub
 ' 新しいクエリを追加するサブルーチン
 Sub AddNewQuery(queryName As String, filePath As String)
     Dim newSheet As Worksheet
     ' 新しいクエリを追加
     ThisWorkbook.Queries.Add Name:=queryName, Formula:= _
         "let" & Chr(13) & Chr(10) & _
         "    ソース = Json.Document(File.Contents(""" & filePath & """))," & Chr(13) & Chr(10) & _
         "    データ = if Type.Is(Value.Type(ソース), type list) then ソース else {ソース}," & Chr(13) & Chr(10) & _
         "    テーブルに変換済み = Table.FromList(データ, Splitter.SplitByNothing(), null, null, ExtraValues.Error)," & Chr(13) & Chr(10) & _
         "    フィールド名 = if Table.IsEmpty(テーブルに変換済み) then {} else Record.FieldNames(テーブルに変換済み{0}[Column1])," & Chr(13) & Chr(10) & _
         "    展開された列 = Table.ExpandRecordColumn(テーブルに変換済み, ""Column1"", フィールド名)" & Chr(13) & Chr(10) & _
         "in" & Chr(13) & Chr(10) & _
         "    展開された列"
     ' 新しいシートを追加し、シート名をJSONファイル名と同じにする
     Set newSheet = ThisWorkbook.Worksheets.Add
     newSheet.Name = queryName
     ' 新しいシートにクエリをインポート
     With newSheet.ListObjects.Add(SourceType:=0, Source:= _
         "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
         , Destination:=newSheet.Range("$A$1")).QueryTable
         .CommandType = xlCmdSql
         .CommandText = Array("SELECT * FROM [" & queryName & "]")
         .RowNumbers = False
         .FillAdjacentFormulas = False
         .PreserveFormatting = True
         .RefreshOnFileOpen = False
         .BackgroundQuery = True
         .RefreshStyle = xlInsertDeleteCells
         .SavePassword = False
         .SaveData = True
         .AdjustColumnWidth = True
         .RefreshPeriod = 0
         .PreserveColumnInfo = True
         .ListObject.DisplayName = queryName
         .Refresh BackgroundQuery:=False
     End With
 End Sub