連続のフォルダ選択について教えて下さい
フォルダの選択をShellで連続して行う時について教えてください。
下記のようなマクロ（途中までですが）がある時
Shellでフォルダ選択の画面が開かれてフォルダを選んで、という作業を9回連続しておこなっています。
この時、指定のフォルダ内には膨大の数のフォルダがあり、1回選択してフォルダ選択の画面が閉じられて
再度フォルダ選択の画面が開くと始めの位置戻ります。それは普通だと思うのですが
今回行いたいのは、1回目にフォルダを選択して、フォルダ選択の画面が閉じられて
再度フォルダ選択の画面が開いた時に、カーソルの位置を1回目に選んだフォルダの位置から開きたいということです。
1回目に選んだフォルダの階層ではなく、カーソルの位置です。指定のフォルダの中に1000以上のフォルダが入っているので
いちいち一番上に戻られると非常に不便です。ネットでも調べてはみましたが、こんな特殊な事をしてる人がおらず
困っています。
もしできるようであれば、教えて下さい。
Sub 回転WARP()
Dim CriteriaName(8), myBox, CriteriaDT(8) As Double, myFolder As Object, _
i As Long, myFolderName As String, NameEnd As String, ParentPath As String, _
OutputCell(9) As String, myIsDate(8) As Boolean, OutputRange As Range
Dim r As Long
OutputCell(0) = "B4:B14" '1つ目のフォルダー名を入力するセルのセル番号
OutputCell(1) = "D22:D32" '2つ目のフォルダー名を入力するセルのセル番号
OutputCell(2) = "P22:P32" '3つ目のフォルダー名を入力するセルのセル番号
OutputCell(3) = "D37:D47" '3つ目のフォルダー名の表わす日時が2つ目のフォルダー名の表わす日時から3時間以上経過しているか否かを表示するセルのセル番号
OutputCell(4) = "P37:P47" '11個前のフォルダー名の表わす日時が1つ目のフォルダー名の表わす日時から3時間以上経過しているか否かを表示するセルのセル番号
OutputCell(5) = "D52:D62" '11個前のフォルダー名の表わす日時が2つ目のフォルダー名の表わす日時から24時間以上経過しているか否かを表示するセルのセル番号
OutputCell(6) = "P52:P62" '3つ目のフォルダー名を入力するセルのセル番号
OutputCell(7) = "D67:D77" '3つ目のフォルダー名の表わす日時が2つ目のフォルダー名の表わす日時から3時間以上経過しているか否かを表示するセルのセル番号
OutputCell(8) = "P67:P77" '11個前のフォルダー名の表わす日時が1つ目のフォルダー名の表わす日時から3時間以上経過しているか否かを表示するセルのセル番号
OutputCell(9) = "D82:D92" '11個前のフォルダー名の表わす日時が2つ目のフォルダー名の表わす日時から24時間以上経過しているか否かを表示するセルのセル番号
NameEnd = "_IKK" '処理の対象とするフォルダー名から日時を表す部分を除いた字列
Set OutputRange = Range("R20:R30") '3つ目のフォルダー名～11個前のフォルダー名を入力するセル範囲
ParentPath = "C:\Users\"
ParentPath = Cells(2, 2).Value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 0 To 8
label1:
Set myFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, i + 1 & "つ目のフォルダーを選択して下さい", _
785, ParentPath & "")
If myFolder Is Nothing Then
myBox = MsgBox(i + 1 & "つ目のフォルダーが選択されていません。" _
& vbCrLf & "フォルダーの選択をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:フォルダーの選択をやり直します" & vbCrLf _
& "[いいえ]:処理を中止してマクロを終了します", _
vbYesNo + vbExclamation, "フォルダー未選択")
If myBox = vbNo Then GoTo sub_Exit
Else
With myFolder.Items.Item
CriteriaName(i) = .Name
myIsDate(i) = Left(CriteriaName(i), 14) & NameEnd = CriteriaName(i) _
And IsDate(Format(Val(CriteriaName(i)), "0000-00-00 00:00:00"))
If myIsDate(i) Then
CriteriaDT(i) = Val(CriteriaName(i))
Else
myBox = MsgBox( _
"選択したフォルダーの名称はこのマクロで処理の対象としている形式の名称になっておりません。" _
& vbCrLf & "このマクロで処理の対象としているのは" & vbCrLf & vbCrLf _
& "yyyymmddhhmmss" & NameEnd & vbCrLf _
& "(4桁の西暦年&2桁の月&2桁の日&2桁の時刻&2桁の分&2桁の秒" & NameEnd & ")" _
& vbCrLf & vbCrLf & "という形式になっているフォルダー名だけです。" _
& vbCrLf & "フォルダーの選択をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:フォルダーの選択をやり直します" & vbCrLf _
& "[いいえ]:このまま処理を続行しますが、日時の比較は行いません。" & vbCrLf _
& "[キャンセル]:処理を中止してマクロを終了します", _
vbYesNoCancel + vbExclamation + vbDefaultButton2, "無効な選択")
Select Case myBox
Case vbCancel
GoTo sub_Exit
Case vbNo
Case Else
GoTo label1
End Select
End If
ParentPath = Left(.Path, InStrRev(.Path, "\") - 1)
End With
End If
Set myFolder = Nothing
Next i
