LoginSignup
0
0

More than 1 year has passed since last update.

VBA,VBSでファイル・フォルダを作成日・更新日順に操作する(Sort記述不要)

Last updated at Posted at 2021-08-23

シンプルに日付順にループしたい!

 VBAでファイルやフォルダのコレクションをForEach文で回しても,For文で回しても,作成日順・更新日順ではない何か不思議なルールに則って処理されますが,たいていは作成日か更新日順に操作したいものです。

PowerShell使ったら?

 基本的には,FileSystemObjectやShell.Applicationのフォルダオブジェクトやファイルオブジェクトやitemをそれぞれ生成して,作成日プロパティを比べて前に後ろに並べてSortすると思いますが,そもそも,powerShellなら一発ですよね。

PowerShell
Set Location "C:\Users\user\"  #任意のフォルダに移動
Get-ChildItem|Sort-Object LastWriteTime|Select-Object Name

これだけで,任意のフォルダに存在するファイル,フォルダのフルパスを最終更新日順に並べて表示できます。

 ただ,PowerShellをスクリプト実行や他のエンジンから呼び出しすると,Set-Locationのカレントフォルダ移動が次の処理までに終わらないケース(バグ?)があるので,Set-Locationは使わずにGet-ChildItemでパスの指定をして実行した方が無難です。
 そして,テキストファイルに結果を吐き出すにはOut-Fileとパス名を付け足して

PowerShell
Get-ChildItem -Path "C:\Users\user\"|Sort-Object LastWriteTime|Select-Object Name|Out-File -FilePath "C:\Users\user\log.log"

という感じになります。
 このPowerShellコマンドをVBA,VBS側から呼んでログを残した後,ログ(テキストファイル)を1行ずつ読み込み,ファイルの存在確認をしつつ処理を行えばよいわけです。

 問題は読み方ですが,ログの形式を確認すると
2021-07-26.png
UTF-16LE(ユーティーエフシックスティーンリトルエンディアン)いわゆるユニコードですから,既定値がUnicodeのADOStreamObjectでいきます。

 OpenTextFileメソッドは既定値がANSI(Shift-Jis/ASCII) なので使いません。
 逆に,ANSIのファイルを読むときはOpenTextFileやOpenメソッドを使う方がシンプルですしバグも少ないです。この辺りの使い分けはデフォルトの値で判断するとよいと思います。

コード

 たとえば,引数folderPathでフォルダのパスを,IsLastWriteTimeで更新日か作成日かの選択を受け取るとすると

VBE
Sub take_in_by_folder(folderPath As String, IsLastWriteTime As Boolean)
    Dim orderKey As String
        If IsLastWriteTime = True Then
            orderKey = "LastWriteTime"
        Else
            orderKey = "CreationTime"
        End If

    Dim wShell As Object
    Set wShell = CreateObject("wscript.shell")

    Dim fso As Object
    Set fso = CreateObject("Scripting.FilesystemObject")
        If InStr(folderPath, ".lnk") Then
            folderPath = wShell.CreateShortcut(folderPath).TargetPath
        End If

    wShell.Run "PowerShell -NoProfile -Command Get-ChildItem -Path " & folderPath & "|Sort-Object " _
                & orderKey & "|Select-Object Name|Out-File -FilePath " & folderPath & "\log.log", 0, True

End Sub

 たとえば,pathsでファイルパスのコレクションを,IsLastWriteTimeで更新日か作成日かの選択を引数で受け取るとすると

VBE
Sub take_in_by_file(paths As Object, IsLastWriteTime As Boolean)
    Dim orderKey As String
        If IsLastWriteTime = True Then
            orderKey = "LastWriteTime"
        Else
            orderKey = "CreationTime"
        End If

    Dim firstFilePath As String
    firstFilePath = paths.Item(1)
    Dim folderDivNum As Integer
    folderDivNum = InStrRev(firstFilePath, "\")
    Dim folderPath As String
    folderPath = Left(firstFilePath, folderDivNum - 1)
        Dim pathStr As String

        For Each path In paths
            If pathStr = "" Then
                pathStr = path
            Else
                pathStr = pathStr & "," & path
            End If
        Next path
    Dim wShell As Object
    Set wShell = CreateObject("wscript.shell")

    wShell.Run "PowerShell -NoProfile -Command Get-ItemProperty -Path " _
                & pathStr & "|Sort-Object " & orderKey & "|Select-Object Name|Out-File -FilePath " & folderPath & "\log.log", 0, True
End Sub

これでPowerShellのエンジンを使ってログを残すことができます。
 ログを使うには

VBE
    Dim fso As Object
    Set fso = CreateObject("Scripting.FilesystemObject")

    Dim logFilePath As String
    logFilePath = folderPath & "\log.log"
    Dim logFile As Object
    Set logFile = fso.GetFile(logFilePath)

    Dim adoDbStream As Object
    Set adoDbStream = CreateObject("ADODB.Stream")
    adoDbStream.Open
    adoDbStream.LoadFromFile logFilePath

    Dim orderReview As String
    orderReview = adoDbStream.ReadText(-1)
    orderReview = Split(orderReview, "Name")(1)
    orderReview = Split(orderReview, "log.log")(0)
        Dim reviewAns As Integer
        reviewAns = MsgBox("この順序で実行します。よろしいですか?" & orderReview, vbInformation + vbOKCancel, "実行確認")
            If reviewAns <> vbOK Then
                fso.DeleteFile (logFilePath)
                Exit Sub
            End If
    adoDbStream.Position = 4

    adoDbStream.LoadFromFile logFilePath
    fso.DeleteFile (logFilePath)

        Do Until adoDbStream.EOS
            Dim logLine As String
            logLine = adoDbStream.ReadText(-2)
            Dim path As String
            path = folderPath & "\" & Trim(logLine)
                If fso.FileExists(path) = True Then
                    'pathでフルパスが取得できるので繰り返し処理を記述
                End If
        Loop
    adoDbStream.Close
End Sub

という感じになります。PowerShell.exeについて(マイクロソフト公式)
 
ちなみに,RunメソッドではなくExecメソッドを使えばPowerShellの実行結果をStreamとして受け取れるので,ログファイルを残すことなく実行することができます。

VBE
Sub exec()
    Dim wShell As Object
    Set wShell = CreateObject("Wscript.Shell")
'全文を一気に読み込む場合
    Set objExec = wShell.exec("powershell.exe -windowStyle hidden -NoProfile -command Get-ChildItem|Sort-Object -Property LastWriteTime|Select-Object -Property Name")
    MsgBox objExec.StdOut.ReadAll
'一行ずつ読み込んでループする場合
    Set objExec = wShell.exec("powershell.exe -windowStyle hidden -NoProfile  -command Get-ChildItem|Sort-Object -Property LastWriteTime|Select-Object -Property FullName")
    Do Until objExec.StdOut.AtEndOfStream      ' 標準出力が終了するまでループ
        strline = objExec.StdOut.ReadLine         ' 1行読み込み
        MsgBox strline
    Loop
End Sub

こんな記載もできます。この場合には,PowerShellの窓が表示されます。
 いずれにせよ,力業でソートするよりも簡単に並び替えできますよ。
 ただ,共有フォルダにアクセスする際はPowerShellの挙動は不安定なので,ローカルな環境で使用する場合に限定した方が無難ではあります。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0