VBS版 スポットライト画像コピー

訳あって、ＰＣを替えたのですが、
なんと、Excel が入ってない。
ＶＢＡをブログ名にしているのに、ありなん？
というところですが・・・（汗）
KINGS SOFTとかいう、互換ソフトは入ってますが、マクロは無し。

無いなら無いで、VBScript があるさと
スポットライト画像コピーマクロを、VBSにしてみました。

シートから、情報を得たり、結果をシートに書き出したりは
できないものの、コピーはできる・・・と

参照設定が、CreateObjectになるので
随分、感じは変わりますが・・・

縦長画像の削除は、jpgで書き出さないと
サイズ情報が取ってこれないので、
一端、コピーしてから後で、削除するという苦肉の策

また、取ってきた横サイズの先頭に
いらん文字が入っていて、苦労しました。

注意：フォルダ内の縦長画像ファイルは、既存でも削除されるので
　　　新規のフォルダで実行のこと


Option Explicit

' 変数を宣言
　Dim UsrId　 : UsrId　 = "HOGEHOGE" 'あなたのユーザー名
　Dim MinSize : MinSize = 500 * 1024 '小さいファイルは対象外
　Dim FromYmd : FromYmd = "2019/03/01" '古いファイルは対象外（何度もしないように）

'-----------------------------------
' オブジェクト定義
'-----------------------------------
　Dim fso
　Dim subf
　Dim objFile

　Dim FileName　 ' ファイル名(元)
　Dim NewName　　' ファイル名(先)
　Dim FromPath　 ' フォルダ名(元)
　Dim ToPath　　 ' フォルダ名(先)

　Set fso = CreateObject("Scripting.FileSystemObject")

　FromPath = "C:\Users\" & UsrId & "\AppData\Local\" _
　　& "Packages\Microsoft.Windows.ContentDeliveryManager_cw5n1h2txyewy\LocalState\Assets\"
　ToPath = fso.getParentFolderName(WScript.ScriptFullName) & "\"

'-----------------------------------
' Assetsフォルダの画像コピー処理
'-----------------------------------
' フォルダ(元)の情報を取得
　Set subf = fso.GetFolder(FromPath)

　For Each objFile In subf.Files
　　' 判定(作成日、サイズ)
　　If Left(objFile.DateCreated,10) >= FromYmd then
　　　If objFile.Size >= MinSize then
　　　　NewName = Right(objFile.Name, 10) + ".jpg"
　　　' ファイルを上書きコピーする
　　　　Call fso.CopyFile(FromPath & objFile.Name, ToPath & NewName, True)
　　　End If
　　End If
　Next

'-----------------------------------
' 縦長画像は削除する
'-----------------------------------
　Dim ImgSizeStr ' 画像サイズ
　Dim ImgSizeTbl ' 画像サイズ格納テーブル
　Dim objFolder
　Dim Xsize
　Dim Ysize

　Set objFolder = WScript.CreateObject("Shell.Application").Namespace(ToPath)
　For Each objFile In objFolder.Items
　　ImgSizeStr = objFolder.GetDetailsOf(objFile, 31)
　　ImgSizeTbl = split(ImgSizeStr, " ")
　　If ImgSizeStr <> "" then
　　　Xsize = Trim(ImgSizeTbl(0))
　　　If ASC(Xsize) = "63" then　　 ' 先頭文字は、ノーブレイクスペースか？
　　　　Xsize = Mid(Xsize,2)
　　　End If
　　　Ysize = Trim(ImgSizeTbl(2))
　　　If (Xsize < Ysize) then
　　　' 縦長画像を削除する
　　　　Call fso.DeleteFile(ToPath & objFolder.GetDetailsOf(objFile, 0),False)
　　　End If
　　End If
　Next

'-----------------------------------
' オブジェクト開放
'-----------------------------------
　Set objFile　 = Nothing
　Set objFolder = Nothing
　Set subf　　　= Nothing
　Set fso　　　 = Nothing