xlogI125’s blog

パソコン作業を効率化したい

Excel VBA: フォルダ内にあるファイルのパスを取得

Get-ChildItemコマンドレットの結果をクリップボード経由でワークシートに貼り付けたほうが早いけど、Excel VBAを使用しての方法を考える。

# PowerShell 5.1, Windows 11 (2024年4月頃)
$fileInfos = Get-ChildItem -File -Force -Recurse -Depth 1 -LiteralPath "${env:USERPROFILE}\Desktop"
$fileInfos.FullName | Sort-Object | Set-Clipboard
' Excel 2019, Windows 11 (2024年4月頃)

' 参照設定
' Microsoft Office 16.0 Object Library
' Microsoft Scripting Runtime

Option Explicit

Public Sub GetFilePath(ByRef paths As VBA.Collection, ByRef folder As Scripting.Folder, ByVal depth As Long)
  Dim f As Scripting.File
  Dim d As Scripting.Folder

  If depth < 0 Then
    Exit Sub
  End If

  On Error GoTo ErrorHandler

  For Each f In folder.Files
    Call paths.Add(Item:=f.Path)
  Next f

  For Each d In folder.SubFolders
    Call GetFilePath(paths, d, depth - 1)
  Next d

  Exit Sub

ErrorHandler:
  Debug.Print folder.Path
  Debug.Assert False

End Sub

Public Sub Main()
  Dim fso As Scripting.FileSystemObject
  Dim dlg As Office.FileDialog
  Dim fld As Scripting.Folder
  Dim paths As VBA.Collection
  Dim depth As Long
  Dim arr2dPath() As String
  Dim sht As Excel.Worksheet
  Dim rng As Excel.Range
  Dim i As Long

  ' FileSystemObject
  Set fso = VBA.Interaction.CreateObject(Class:="Scripting.FileSystemObject")

  ' FolderPicker
  Set dlg = Excel.Application.FileDialog(FileDialogType:=Office.MsoFileDialogType.msoFileDialogFolderPicker)
  dlg.Title = "フォルダ選択"
  dlg.InitialFileName = VBA.Interaction.Environ(Expression:="USERPROFILE") & "\Desktop\"

  If dlg.Show = 0 Then
    Call Err.Raise(Number:=513, Description:="フォルダが選択されていません")
    Exit Sub
  End If

  ' Folderオブジェクト
  Set fld = fso.GetFolder(FolderPath:=dlg.SelectedItems.Item(1))

  ' ファイルのパスを入れるコレクション
  Set paths = New VBA.Collection

  ' InputBoxメソッドで再帰の深さを入力
  depth = Excel.Application.InputBox(Prompt:="depth", Title:="再帰の深さ", Default:=1, Type:=1)

  ' ファイルのパスを取得
  Call GetFilePath(paths, fld, depth)

  If paths.Count = 0 Then
    Call Err.Raise(Number:=514, Description:="ファイルがありません")
    Exit Sub
  End If

  ' セルに値を設定するための2次元配列
  ReDim arr2dPath(1 To paths.Count, 1 To 1)

  ' コレクションから2次元配列にコピー
  For i = 1 To UBound(arr2dPath, 1) Step 1
    arr2dPath(i, 1) = paths.Item(i)
  Next i

  ' ワークシートのセル範囲を取得
  Set sht = Excel.Application.ActiveWindow.ActiveSheet
  Set rng = sht.Range(sht.Cells.Item(1, 1), sht.Cells.Item(UBound(arr2dPath, 1), 1))

  ' 2次元配列の値をセル範囲の値に設定
  rng.Value2 = arr2dPath

  ' 並べ替え
  Call rng.Sort( _
    Key1:=rng.Columns.Item(1), _
    Order1:=Excel.XlSortOrder.xlAscending, _
    Header:=Excel.XlYesNoGuess.xlNo, _
    MatchCase:=False, _
    Orientation:=Excel.XlSortOrientation.xlSortColumns, _
    SortMethod:=Excel.XlSortMethod.xlPinYin, _
    DataOption1:=Excel.XlSortDataOption.xlSortNormal _
  )
End Sub

VBA: WshShell.Exec("PowerShell -Command -")

VBA: WshShell.Exec

Excelマクロから簡単にPowerShellの出力結果を取得する方法を考える

' Excel 2019, Windows 11 (2024年4月頃)

' 参照設定
' Windows Script Host Object Model

Option Explicit

Public Function f(ByVal cmd As String)
  Dim exitCode As Long

  Dim scOut As New VBA.Collection
  Dim scErr As New VBA.Collection

  Dim i As Long

  ' WshShell Object
  Dim wshShell As Object ' IWshRuntimeLibrary.wshShell
  Set wshShell = VBA.Interaction.CreateObject("WScript.Shell")

  ' WshScriptExec Object
  Dim wshScriptExec As Object ' IWshRuntimeLibrary.wshExec
  Set wshScriptExec = wshShell.Exec("PowerShell.exe -NoProfile -NonInteractive -WindowStyle Hidden -Command -")

  ' TextStream Object
  With wshScriptExec.StdIn
    .WriteLine cmd
    .Close
  End With

  ' TextStream Object
  With wshScriptExec.StdOut
    Do Until .AtEndOfStream
      scOut.Add .ReadLine()
    Loop
    .Close
  End With

  ' TextStream Object
  With wshScriptExec.StdErr
    Do Until .AtEndOfStream
      scErr.Add .ReadLine()
    Loop
    .Close
  End With

  Set wshScriptExec = Nothing

  Set wshShell = Nothing

  For i = 1 To scOut.Count Step 1
    Debug.Print scOut.Item(i)
  Next i

  For i = 1 To scErr.Count Step 1
    Debug.Print scErr.Item(i)
  Next i

  f = exitCode
End Function

Public Sub main()
  Debug.Print f( _
    "Set-StrictMode -Version Latest" & VBA.Constants.vbCrLf & _
    "Set-Location -LiteralPath ""${env:USERPROFILE}\Desktop""" & VBA.Constants.vbCrLf & _
    "(Get-ChildItem).Name" & VBA.Constants.vbCrLf & _
    "Write-Error ""Errorテスト""" & VBA.Constants.vbCrLf & _
    "exit" _
  )
End Sub

PowerShell: WshShell.Exec

COMオブジェクトの解放は気にしない

# PowerShell 5.1, Windows 11 (2024年4月頃)

Set-StrictMode -Version Latest

$sb = {
  param([Parameter(Mandatory)][ValidateNotNullOrEmpty()][string]$cmd)

  # StringCollection
  $scOut = [System.Collections.Specialized.StringCollection]::new()
  $scErr = [System.Collections.Specialized.StringCollection]::new()

  # WshShell Object
  $wshShell = [System.Activator]::CreateInstance([System.Type]::GetTypeFromProgID("WScript.Shell"))

  # WshScriptExec Object
  $wshScriptExec = $wshShell.Exec("PowerShell.exe -NoProfile -NonInteractive -WindowStyle Normal -Command -")

  # TextStream Object
  $textStreamIn = $wshScriptExec.StdIn
  $textStreamIn.WriteLine($cmd)
  $textStreamIn.Close()
  $textStreamIn = $null

  # TextStream Object
  $textStreamOut = $wshScriptExec.StdOut
  while (-not $textStreamOut.AtEndOfStream) { $null = $scOut.Add($textStreamOut.ReadLine()) }
  $textStreamOut.Close()
  $textStreamOut = $null

  # TextStream Object
  $textStreamErr = $wshScriptExec.StdErr
  while (-not $textStreamErr.AtEndOfStream) { $null = $scErr.Add($textStreamErr.ReadLine()) }
  $textStreamErr.Close()
  $textStreamErr = $null

  $exitCode = $wshScriptExec.ExitCode

  $wshScriptExec = $null

  $wshShell = $null

  $scOut | Write-Host -ForegroundColor Cyan
  $scErr | Write-Host -ForegroundColor Magenta

  return $exitCode
}

Invoke-Command -ScriptBlock $sb -ArgumentList @'
Set-StrictMode -Version Latest
Set-Location -LiteralPath "${env:USERPROFILE}\Desktop"
(Get-ChildItem).Name
Write-Error "Errorテスト"
exit
'@

PowerShell: ProcessStartInfo

Start-Processコマンドレットの-WaitパラメーターではなくProcess.WaitForExitメソッドを使いたい場合があるのでProcessStartInfoクラスを使う

# PowerShell 5.1, Windows 11 (2024年4月頃)

Set-StrictMode -Version Latest

$sb = {
  param([Parameter(Mandatory)][ValidateNotNullOrEmpty()][string]$cmd)

  $scOut = [System.Collections.Specialized.StringCollection]::new()
  $scErr = [System.Collections.Specialized.StringCollection]::new()

  # Process
  $p = [System.Diagnostics.Process]::new()

  # ProcessStartInfo
  $p.StartInfo.FileName = "PowerShell.exe"
  $p.StartInfo.Arguments = "-NoProfile -NonInteractive -WindowStyle Normal -Command -"
  $p.StartInfo.UseShellExecute = $false
  $p.StartInfo.RedirectStandardInput = $true
  $p.StartInfo.RedirectStandardOutput = $true
  $p.StartInfo.RedirectStandardError = $true

  $null = $p.Start()

  $p.StandardInput.WriteLine($cmd)
  $p.StandardInput.Close()

  $p.WaitForExit()

  # StreamReader
  while (-not $p.StandardOutput.EndOfStream) {
    $null = $scOut.Add($p.StandardOutput.ReadLine())
  }
  $p.StandardOutput.Close()

  # StreamReader
  while (-not $p.StandardError.EndOfStream) {
    $null = $scErr.Add($p.StandardError.ReadLine())
  }
  $p.StandardError.Close()

  $exitCode = $p.ExitCode

  $p.Dispose()

  $scOut | Write-Host -ForegroundColor Cyan
  $scErr | Write-Host -ForegroundColor Magenta

  return $exitCode
}

Invoke-Command -ScriptBlock $sb -ArgumentList @'
Set-StrictMode -Version Latest
Set-Location -LiteralPath "${env:USERPROFILE}\Desktop"
Get-ChildItem | Format-Table -AutoSize | Out-String -Width 80 | Write-Host
Write-Error "Errorテスト"
exit
'@

Webブラウザ JavaScript ハッシュ値

crypto.subtle.digestでファイルのハッシュ値を求める。
PowerShellGet-FileHashコマンドレットではなく、Webブラウザでファイルのハッシュ値を求める方法を考える。

filesプロパティ(<input type="file">)

選択されたファイルのハッシュ値を出力

// <!doctype html>
// <html><body><script>
"use strict";

// テスト環境: Edge, Firefox, Windows 11 (2024年4月頃)

// スタイルシート
let sheet = new CSSStyleSheet();
sheet.insertRule("table { border-collapse: collapse; }");
sheet.insertRule("th, td { border: 1px solid black; padding: 0.5em; }");
document.adoptedStyleSheets = [sheet];

// input 要素
let elmInputFile = document.createElement("input");
elmInputFile.type = "file";
elmInputFile.multiple = true;
document.body.appendChild(elmInputFile);

document.body.appendChild(document.createElement("br"));

// button 要素
let elmButton = document.createElement("button");
elmButton.innerText = "クリック";
document.body.appendChild(elmButton);

document.body.appendChild(document.createElement("br"));

// ボタン click
elmButton.onclick = function() {
  // table 要素
  let elmTable = document.createElement("table");
  document.body.appendChild(elmTable);
  let elmTbody = document.createElement("tbody");
  elmTable.appendChild(elmTbody);
  elmTbody.insertAdjacentHTML("beforeend", "<tr><th>Name</th><th>Hash</th></tr>") 

  // crypto.subtle.digest
  for (const file of elmInputFile.files) {
    file.arrayBuffer().then(arrBuf => {
      crypto.subtle.digest("SHA-256", arrBuf).then(arrBuf => {
        const strHash = Array.from(new Uint8Array(arrBuf)).map(byte => byte.toString(16).padStart(2, "0")).join("").toUpperCase();
        elmTbody.insertAdjacentHTML("beforeend", `<tr><td>${file.name}</td><td>${strHash}</th></td>`) 
      });
    });
  }

  document.body.appendChild(document.createElement("br"));
};
// </script></body></html>

dataTransfer.files

Fileオブジェクトのnameプロパティなどを表示

// <!doctype html>
// <html><body><script>
"use strict";

// テスト環境: Edge, Firefox, Windows 11 (2024年4月頃)

let elmTextarea = document.createElement("textarea");
document.body.appendChild(elmTextarea);

elmTextarea.textContent = "ここにファイルをドラッグ&ドロップ";

// dragover イベント
elmTextarea.addEventListener("dragover", function(event) {
  event.preventDefault();
  console.log(event);
  event.target.textContent = "dragover イベント";
});

// drop イベント
elmTextarea.addEventListener("drop", function(event) {
  event.preventDefault();
  console.log(event);
  event.target.textContent = "";

  // dataTransfer プロパティ
  for (const file of event.dataTransfer.files) {
    event.target.textContent += JSON.stringify({ name: file.name, type: file.type, size: file.size }) + "\n";
  }

});
// </script></body></html>

参考: Get-FileHashコマンドレット

フォームにドラッグされたファイルのハッシュ値をテキストボックスに表示

# PowerShell 5.1, Windows 11 (2024年4月頃)

$ErrorActionPreference = "Stop"
$VerbosePreference = "Continue"

Set-StrictMode -Version Latest

Add-Type -Language CSharp -Namespace Win32API -Name Shlwapi -MemberDefinition @'
  [DllImport("Shlwapi.dll", EntryPoint = "StrCmpLogicalW", CharSet = CharSet.Unicode)]
  public static extern int StrCmpLogicalW([MarshalAs(UnmanagedType.LPWStr)] string psz1, [MarshalAs(UnmanagedType.LPWStr)] string psz2);
'@

Add-Type -AssemblyName System.Windows.Forms

# フォーム
$form = [Windows.Forms.Form]::new()
$form.Text = "ファイルをドラッグ&ドロップ"
$form.Size = [System.Drawing.Size]::new(800, 600)
$form.FormBorderStyle = [System.Windows.Forms.FormBorderStyle]::FixedDialog
$form.AllowDrop = $true

# テキストボックス
$textBox = [System.Windows.Forms.TextBox]::new()
$textBox.Size = [System.Drawing.Size]::new(
  800 - [System.Windows.Forms.SystemInformation]::VerticalScrollBarWidth, 
  600 - [System.Windows.Forms.SystemInformation]::HorizontalScrollBarHeight - [System.Windows.Forms.SystemInformation]::CaptionHeight
)
$textBox.AutoSize = $false
$textBox.Font = [System.Drawing.Font]::new("MS ゴシック", 12)
$textBox.Multiline = $true
$textBox.AcceptsReturn = $true
$textBox.WordWrap = $false
$textBox.ScrollBars = [System.Windows.Forms.ScrollBars]::Both
$textBox.ShortcutsEnabled = $true

$form.Controls.Add($textBox)

# DragEnterイベント
$form.add_DragEnter({
  param([object]$sender, [System.Windows.Forms.DragEventArgs]$e)
  try {
    $e.Effect = [System.Windows.Forms.DragDropEffects]::Copy
  }
  catch {
    $_ | Write-Verbose
  }
} -as [System.Windows.Forms.DragEventHandler])

# DragDropイベント
$form.add_DragDrop({
  param([object]$sender, [System.Windows.Forms.DragEventArgs]$e)
  try {
    # ファイルのパス
    $paths = [string[]]$e.Data.GetFileDropList()
    # パスをソート
    [System.Array]::Sort($paths, { param([string]$x, [string]$y); return [Win32API.Shlwapi]::StrCmpLogicalW($x, $y) } -as [System.Comparison[string]])
    # ファイルのハッシュ値
    $fileHashs = Get-FileHash -LiteralPath $paths

    foreach ($fileHash in $fileHashs) {
      # 空白行を削除
      $strs = ($fileHash | Format-List -Property @{ Name = "Name"; Expression = { [System.IO.Path]::GetFileName($_.Path) } }, Hash, Algorithm | Out-String -Width 80 -Stream) -ne ""
      $str = $strs -join "`r`n"
      # ファイルのハッシュ値をテキストボックスに表示
      $textBox.Text += $str + "`r`n`r`n"
    }

    # テキストボックスをスクロール
    $textBox.Select($textBox.Text.Length, 0)
    $textBox.ScrollToCaret()
  }
  catch {
    $_ | Write-Verbose
  }
} -as [System.Windows.Forms.DragEventHandler])

$form.ShowDialog()