[[20200929112445]]　『Do While Loopに変更したいです。』（はま）　ページの最後に飛ぶ

『Do While Loopに変更したいです。』（はま）

VBA初心者です。同フォルダ内のExcelの特定のデータを抽出するプログラムを組む課題でFor　Each　Nextを使って以下のプログラムを組みました。
今度はDo While Loopを使って同じプログラムを作りたいのですが、エラーが発生し上手くいきません。Do While Loopに変更した以下のプログラムを教えてもらえないでしょうか。

Sub test()

    If MsgBox("処理を実施しますか", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If

    Dim objFSo As Object
    Dim objFolder As Object
    Dim objFile As Object

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long
    Dim l As Long

    l = 2

    Set objFSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSo.GetFolder(ThisWorkbook.Path)

    For Each objFile In objFolder.Files

        If Mid(objFile.Name, 1, 4) = "File" And Right(objFile.Name, 5) = ".xlsx" Then

            Set wb = Workbooks.Open(objFile)

                For Each ws In wb.Sheets

                    If ws.Name = "銀行" Or ws.Name = "ゆうちょ" Then

                        For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row

                            ThisWorkbook.Worksheets("リスト").Cells(l, 1).Value = wb.Name
                            ThisWorkbook.Worksheets("リスト").Cells(l, 2).Value = ws.Name
                            ThisWorkbook.Worksheets("リスト").Cells(l, 3).Value = ws.Cells(i, 1)
                            ThisWorkbook.Worksheets("リスト").Cells(l, 4).Value = ws.Cells(i, 2)

                            l = l + 1

                        Next i

                    End If

                Next ws

            wb.Close
            Set wb = Nothing

        End If

    Next

    Set objFSo = Nothing
    Set objFolder = Nothing

    MsgBox ("処理完了" & vbCrLf & "処理件数: " & l - 2 & "件"), , "課題"

End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

＞今度はDo While Loopを使って同じプログラムを作りたい
それは何故なんですか？
今のコードのどのあたりが問題なんですか？
私には特に問題はないように思いますが。

（γ） 2020/09/29(火) 11:44

まずは、エラーが発生する現在のコードを書いて下さい。それが無いと、何処をどう間違えているのか指摘できませんから。

それに、For Each の方が While のループより、優れていると思いますよ？ While や Do のループは、終了条件を間違えると、簡単に無限ループしてしまい、強制終了するしかなくなりますからね。課題だったとするなら、実は For Each を使ったコードは自作ではなく、先生にそれを見抜かれた、とか？そうでもないと、わざわざ危険なコードに改悪する意味が判らないです。
（???） 2020/09/29(火) 11:49

 是非はともかく、出来るかどうか検索してみましたが、インデックスに数値が使用できないようです。

https://stackoverflow.com/questions/34560643/can-i-use-filesystemobject-get-a-single-file-from-a-folder-using-its-index

https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/windows-scripting/hh779003(v=vs.84)?redirectedfrom=MSDN

 となるといったん全ファイル名を配列に取得して、ってそこで For Each が必要になりますね・・・。

（QS） 2020/09/29(火) 12:52

課題自体は上記のFor Each Nextwoを使ったプログラムでOKをもらっているのですが、より理解を深めるために、追加課題としてDo While Loopを使ったプログラムに変更するよう言われています。

フォルダ内にファイルが存在する限り、処理をし続けるという形でDo Loop Whileを使いたくて
以下のプログラムに変更したのですが、コンパイルエラー：　修正候補：ステートメントの最後の
エラーが出ている状況です。

Sub test()

    If MsgBox("処理を実施しますか", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If

    Dim objFSo As Object
    Dim objFolder As Object
    Dim objFile As Object

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long
    Dim l As Long

    l = 2

    Set objFSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSo.GetFolder(ThisWorkbook.Path)

    Do While objFile In objFolder.Files <> ""

        If Mid(objFile.Name, 1, 4) = "File" And Right(objFile.Name, 5) = ".xlsx" Then

            Set wb = Workbooks.Open(objFile)

                For Each ws In wb.Sheets

                    If ws.Name = "銀行" Or ws.Name = "ゆうちょ" Then

                        For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row

                            ThisWorkbook.Worksheets("リスト").Cells(l, 1).Value = wb.Name
                            ThisWorkbook.Worksheets("リスト").Cells(l, 2).Value = ws.Name
                            ThisWorkbook.Worksheets("リスト").Cells(l, 3).Value = ws.Cells(i, 1)
                            ThisWorkbook.Worksheets("リスト").Cells(l, 4).Value = ws.Cells(i, 2)

                            l = l + 1

                        Next i

                    End If

                Next ws

            wb.Close
            Set wb = Nothing

        End If

    Loop

    Set objFSo = Nothing
    Set objFolder = Nothing

    MsgBox ("処理完了" & vbCrLf & "処理件数: " & l - 2 & "件"), , "課題"

End Sub

（はま） 2020/09/29(火) 13:02

FSOは気を利かせてiteratorで抽象化しているんですね。
For each .. Nextを使えと。

どうしてもというなら、Dir関数を使うんでしょうか？
返り値が<>""の間、繰り返すと。
そうすれば、お望みどおり Do Loopになりますね。

質問者さんは、Do Loopが一番基本で、できるだけこれを使うのがよい、
とでも思っておられるんでしょうか。
まったく錯覚ですね。

For each .. Nextが最上。
For k = 1 to n ..Nextが次。
Do Loopは予め終わりが確定していないとか、特別の時に使う、という感じかと思います。
（γ） 2020/09/29(火) 13:07

被ってる感満載ですが。

おそらくですが、ポイントはどうやってフォルダ内にある条件にあうブックの「フルパス」を得るかじゃないですかね。

その観点で言えばフルパスの長さにもよりますが、Do～LoopとDir関数を組み合わせる方法もよく使われるとおもいますから研究してみてはどうですか？
http://officetanaka.net/excel/vba/file/file07.htm

（もこな２） 2020/09/29(火) 13:50

ふむ、FSOのFilesコレクションは、インデックス指定できないから、For Each で取り出すしかないようですね。（ローカルウィンドウ等では、itemとしてファイル数分見る事ができるのですけどねぇ）

whileループで書きたいなら、FSOを使わずに、全部書き直すしかないようです。
https://www.moug.net/tech/exvba/0060001.html

自ブックと同じフォルダを見るだけなら、普通にDir関数を使ってはどうですか？授業で習ったのはFSOではなく、こっちでは？
（???） 2020/09/29(火) 15:16

 先の質問サイトの回答にありましたが、
 dim shellApp
 set shellApp = CreateObject("Shell.Application")
 dim myFolder
 Set myFolder = shellApp.NameSpace("E:\test")
 Dim myfiles
 Set myfiles = myFolder.Items 'also contains subfolders

 Dim i
 For i = 0 To myfiles.Count - 1
     WScript.Echo myfiles.Item(i).Path
 Next

 ならできるようです。
 まぁ、これを Do While にするメリットは感じられませんが。
（QS） 2020/09/29(火) 16:05

皆さん
ありがとうございました。
無事、プログラムを組み直すことができました。
（はま） 2020/09/29(火) 17:54

コメント返信：

[ 一覧(最新更新順) ]

[[20200929112445]] 『Do While Loopに変更したいです。』（はま） ページの最後に飛ぶ

[[20200929112445]]　『Do While Loopに変更したいです。』（はま）　ページの最後に飛ぶ