③自動暗号化／復号ファイルとつきあう 一応解決。

今日から仕事でした。いつもならモウカヨ・・というところですが，試したいことがあったので朝から意気揚々と行ってきました。

自動暗号化ファイルへの挑戦です。

thomさんにとても有用なアドバイスをいただいていました。

WshShellのRunで開くなら，きっとやれるだろうと思い，試したくて数日前からうずうずしていたので，午前中取り組んでみた。

問題はないとは思いつつ，何がセキュリティホールになるかわからない世の中ですし，いろいろと隠していますがご了承を。

雰囲気はこんな感じです。アイコンを見てExcelの仲間だとわかります。-xlsxというのは残ってるのでどう見てもExcel由来なんですが，暗号化されているんです。

開いてしまえば普通のExcelブックとなります。ですが，ExcelVBAのWorkbooks.Openとかでは開けません。

結論から言えば，実用段階までは持ってこれたと思います。コードを載せてコメントします。

①まとめて開くタイプ

Option Explicit
Dim lngColFileNo As Long

Sub フォルダ内のファイルを操作()
    Application.DisplayAlerts = False
    
    Dim FD As FileDialog
    Dim SelectedFile As Variant
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .Title = "フォルダを選んで下さい"
        .InitialView = msoFileDialogViewList
        If .Show = True Then
            Set SelectedFile = .SelectedItems
        End If
    End With

    Dim strFileName As String: strFileName = Dir(SelectedFile(1) & "\", vbNormal)
    Dim colFileName As Collection, i As Long, strProc As String
    Set colFileName = New Collection

    Do While strFileName <> ""
        If strFileName <> ThisWorkbook.Name Then
            colFileName.Add strFileName
        End If
        '次のファイルを取得
        strFileName = Dir()
    Loop

    Dim objShell As Object: Set objShell = CreateObject("Wscript.shell")
    lngColFileNo = colFileName.Count
    For i = 1 To lngColFileNo
        objShell.Run """" & SelectedFile(1) & "\" & colFileName(i) & """"
    Next

    Application.OnTime DateAdd("s", 1, Now), "proc2"

    Application.DisplayAlerts = True

End Sub


Sub proc2()
    Debug.Print "Proc2 " & Workbooks.Count & "," & lngColFileNo + 1

    If Workbooks.Count = lngColFileNo + 1 Then
        Call Proc3
    Else
        Application.OnTime DateAdd("s", 1, Now), "proc2"
    End If
End Sub

Sub Proc3()
    Debug.Print "proc3 "
    Dim wb As Workbook
    Dim i As Long: i = 1
    '開いているブックに対する処理
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            ThisWorkbook.Worksheets(1).Cells(i, 1) = wb.Name
            i = i + 1
        End If
    Next
    '処理ここまで

    '閉じます
    Do
        For Each wb In Workbooks
            If wb.Name <> ThisWorkbook.Name Then wb.Close
        Next
    Loop Until Workbooks.Count = 1

End Sub

コレクションを開放し忘れてますね・・検証できませんので，編集はしません。
これでとりあえずまとめて開いて，なにかデータを収集するってことができる感じです。
ここではブックの名前を取得するという簡単なことだけしています。

いくつかのファイルでもたついているのがこのイミディエイトウィンドウから伝わるでしょうか。マクロを含むファイルとか，
何かの影響で読み取り専用で開くけどいいかい?と聞かれたりするときにもたつくと，1秒では開けないのでループする感じです。

まとめて開いて処理のほうが楽なケースはこれで十分動いてました。

ただ，開くファイル数が膨大な時とかはちょっとこれでは大変なので，開いて処理，を繰り返す私が好きな動きで組んだのが次です。

②１つずつ　開いて処理を繰り返す。

Option Explicit
Dim colFileName As Collection
Dim lngColFileNo As Long
Dim FolderPath As String
Dim lngTimeOut As Long

Sub Proc1フォルダ内のファイルを操作()
    Dim FD As FileDialog
    Dim SelectedFile As Variant
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .Title = "フォルダを選んで下さい"
        .InitialView = msoFileDialogViewList
        If .Show = True Then
            FolderPath = .SelectedItems(1)
        End If
    End With
    If FolderPath = "" Then Exit Sub

    Dim strFileName As String: strFileName = Dir(FolderPath & "\", vbNormal)
    Dim i As Long
    Set colFileName = New Collection
    lngColFileNo = 1
    
    Do While strFileName <> ""
        If strFileName <> ThisWorkbook.Name Then
            colFileName.Add strFileName
        End If
        '次のファイルを取得
        strFileName = Dir()
    Loop
    
    'ファイルリスト表示
    For i = 1 To colFileName.Count
        Debug.Print i & ":" & colFileName(i)
    Next
    Debug.Print "--------がんばりますよ---------"
    
    Call Proc2ファイルを開く
End Sub

Sub Proc2ファイルを開く()
    Dim objShell As Object: Set objShell = CreateObject("Wscript.shell")
        
    objShell.Run ("""" & FolderPath & "\" & colFileName(lngColFileNo) & """")
    
    Application.OnTime DateAdd("s", 1, Now), "Proc3ファイルに操作"
    lngTimeOut = 0
End Sub

Sub Proc3ファイルに操作()

    Debug.Print "  Proc3 " & lngColFileNo & "/" & colFileName.Count & " ," & colFileName(lngColFileNo) & "読み込みトライ中 " & lngTimeOut
    If lngTimeOut = 30 Then
        Debug.Print "30秒のトライ中に開けなかったので，中途終了します。"
        MsgBox "30秒のトライ中に開けなかったので，中途終了します。"
        Set colFileName = Nothing
        Exit Sub
    End If
    
    If Workbooks.Count = 1 Then
        Application.OnTime DateAdd("s", 1, Now), "Proc3ファイルに操作"
        lngTimeOut = lngTimeOut + 1
        Exit Sub
    End If
    
    
    '各ファイルに操作
    Debug.Print Workbooks(2).Name & "の作業開始"
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(lngColFileNo, 1) = Workbooks(2).Name
        .Cells(lngColFileNo, 2) = Workbooks(2).Worksheets(1).Cells(1, 1)
    End With
    Debug.Print Workbooks(2).Name & "の作業終了"
    
    '閉じる
    Workbooks(2).Close
    
    lngColFileNo = lngColFileNo + 1
    If lngColFileNo <= colFileName.Count Then Application.OnTime DateAdd("s", 1, Now), "Proc2ファイルを開く"
    
    '全部終わったら
    If lngColFileNo = colFileName.Count + 1 Then
        Debug.Print "後片付け"
        Set colFileName = Nothing
    End If
End Sub

OnTimeのプロシージャに引数渡すところで失敗したので，モジュールレベルで宣言した変数でごまかしました。
そこらへんは恥ずかしい感じです。

これで処理をしたら次のようなかんじ。

やはり，セキュリティの警告とか読み取り専用だけどね!というのの相手をしていると，若干遅れます。
その間ループして待たせています。もたつき加減が伝わるかもしれません。もたついても動く証拠とも言える・・はず。

ただ，WShShellのRunで開いている途中で『いいえ』でからぶった時，返り値からも判別しきれなかったので，
３０秒間ブックが増えなかったらタイムアウトさせるようにしました。

開いたファイルだけでも継続するようにしたほうがよかったんですが，職場ではそれを思いつかず切っちゃいました。

なにはともあれ，開いて処理をする，ということはほぼ確実にできるようになりました。
以前考えていた　開かれる方に処理を持たせる方法とこのあたりを合わせれば，十分自己暗号化ファイルと仕事ができそうだ，
というところまでこれたので，アドバイスをくださったthomさん　深く感謝です。_(._.)_

今日一番驚いた想定外は，thisworkbooks.pathが利用できなかったこと。

自分自身が暗号化されているとき，復号したものをどこかテンポラリぽいとこに置いているみたいで，処理対象のファイルと同じフォルダに処理ファイルを置いて実行しても，
ここには他に，ファイルはないよと怒られて愕然としました。

普通にフォルダを取って指定してあげれば何の問題もありませんでしたが，理解するまでナンダコレハ(;´▽｀A``となったので，

やっぱりやってみないとわからないもんだなぁと思いました。(ﾟ▽ﾟ*)

ほんと，，これは自力解決できた気がしないのでありがたかった。Ontimeが使えないPowerpointとかでは他ファイルとあまり付き合わないので助かる(;´▽｀A``

追記・・どう考えてもExcelVBAでした。。(;´▽｀A``