質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.48%

  • VBA

    2377questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • VB.NET

    1072questions

    Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

DoEventsが無限ループを引き起こす

受付中

回答 7

投稿 編集

  • 評価
  • クリップ 2
  • VIEW 5,862

ExcelVBAer

score 1093

処理が長くなるFor文で、Excelが固まらないよう、途中で定期的にDoEventsをさせてるのですが、
稀に、DoEventsが暴走し、説明しにくいのですが無限ループ的になってしまいます。

もしどなたか知見をお持ちでしたら、
ご教授頂けますと幸いです。

同じ状況を経験した、という方がいらっしゃれば、
ご連絡頂ければ何か糸口が見つかるかもしれません。

下記がDoEvents用のモジュールで、
For分の途中で「fDoEvents」をCallしており、
「★」の箇所で再帰的に関数が呼ばれるようになってしまいます。。。

処理としては、あるフォルダの容量を知る為に、
フォルダ内のファイルを全て検索し、
各ファイル容量を基にフォルダ容量を計算する、
という処理のファイル検索の途中でfDoEventsを呼び出しています。

どうぞ宜しくお願い致します。

Declare Function GetInputState Lib "user32" () As Long
Private DoTime  As Double
Public Function fDoEvents()

    If GetInputState Then
        Call prDoEvent
        Exit Function
    End If

    '一定時間(1秒)たっていたらDoEvents
    If Abs(Timer - DoTime) > 1 Then
        Call prDoEvent
        Exit Function
    End If

End Function

Private Function prDoEvent()

    '一定間隔処理用に処理時点の時間を保持
    DoTime = Timer

    '実行 
    DoEvents '★稀に、DoEvents実行直後に「prDoEvent」が呼ばれ、再帰的に呼ばれ続けてしまう

End Function

ファイル検索用の関数を追記いたします(1/30)

Public Function fFile_Path_in_Folder(Path_Folder As String, _
                                     Optional Extention As String = "*", _
                                     Optional FileAttribute As VbFileAttribute = vbNormal) As Variant


    '- 指定フォルダが無かった場合、終了
    If FSO.FolderExists(Path_Folder) = False Then Exit Function

    'フォルダパスを格納
    Dim Path_FD     As String
    Path_FD = Path_Folder
    If Right$(Path_FD, 1) <> Application.PathSeparator Then
        Path_FD = Path_FD & Application.PathSeparator
    End If

    Dim Dic As Scripting.Dictionary
    Set Dic = New Scripting.Dictionary

    '最初のファイルパスを取得
    'Dir関数に検索パスを設定
    Dim FileName   As String
    FileName = Dir(Path_FD & "*" & "." & Extention, FileAttribute)

    Do While FileName <> ""

        Call fDoEvents

        Dim Path_File   As String
        Path_File = Path_FD & FileName

        'ファイルパスを辞書に登録
        If Directory_IsFolder(Path_File) = False Then
            Dic.Item(FileName) = Path_File
        End If

        '次のファイルパスを取得
        FileName = Dir()

    Loop

    'ファイルロックの開放(念のため)
    Call Dir(vbNullString)

    If Dic.Count = 0 Then Exit Function

    '- 戻り値
    fFile_Path_in_Folder = Dic.Items

    Set Dic = Nothing

End Function
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • ExcelVBAer

    2018/03/06 13:43

    気にかけて頂き、ありがとうございます。 しかし残念ながら、全く再現しなくなってしまい、何もわからない状況となっています。

    キャンセル

  • sazi

    2018/03/07 00:57

    対処が有効だったって事ですか?

    キャンセル

  • ExcelVBAer

    2018/03/08 09:15

    同じコードで再現が見られなくなった、という状況です。。。

    キャンセル

回答 7

+2

Doeventsで処理されているのは、こちらについての対応の為でしょうか?

でしたら、ループ中で毎回発行するのではなく10回に1回とかの割合で発行されるようにした方が良いのではないかと思います。(そもそも処理時間が掛かっている為の回避策に時間の間隔を条件にしてもという気が)

追記

無限ループというより、Doeventsの発行がなされないということは考えられないでしょうか。
現在は、ループ中でDoevensを呼び出していると思いますが、その処理自体が応答なしの状態では、Doeventsの発行のしようがないと思われます。

ループ開始前にApplication.OnTime メソッド (Excel)によって、定期的に呼び出すようにしてみてはどうでしょう。

因みに、Doeventsなどのイベント絡みをブレークポイントを設定して動作確認しようとしても、徒労に終わるケースが多いです。
なぜなら、ブレークポイントを設定すること自体でイベント消化が行われ、発生している事象の再現にはならないからです。

追記2

元々ループ中の処理

あるフォルダの容量を知る為に、フォルダ内のファイルを全て検索し、各ファイル容量を基にフォルダ容量を計算する

というのがどのようなコマンドで行われているのかは不明ですが、非同期処理であるが為に、Doeventsを行っているんだと思います。
この処理を同期型の処理に置き換えるのも別解になるかと。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/30 13:14

    時間がかかっている為の回避策ではなく、時間がかかって「応答停止」になるのを回避する為、という対処としています。
    回数で判断しても良いのかもしれませんね。試してみます。
    (といっても、どういう時に再現するかも判明できておらず、苦戦しております。。。)

    キャンセル

  • 2018/01/30 14:53

    すみません、For文ではなく、Do Loop の間違いでした。
    該当関数 fFile_Path_in_Folder を追記してますので、
    参照頂けますと幸いです。

    キャンセル

  • 2018/01/30 15:06

    dir()ではなく、FileSystemObjectを使用し、インスタンスを生成することで同期処理となり、Doeventsは不要になると思われますが。

    キャンセル

  • 2018/01/30 15:14

    DoEvents は、処理が長い時に「応答なし」状態で固まるので、
    それを回避する為に使用しております。

    同期処理、という概念について不勉強なのですが、
    Dir()が非同期処理で、FSOは同期処理、
    ということでしょうか?

    Dir と DoEvents を同じようなタイミングで繰り返し呼び出す、
    という事に問題があるということなのでしょうか?

    キャンセル

  • 2018/01/30 15:24 編集

    逆説的に、Doeventsを使用されているということなので非同期処理として扱われているのだろう程度です。
    しかしながら、Dir()関数はインスタンスを持ちませんし、非同期であることは十分考えられます。
    ※ループで続きの処理になることからも、非同期で会話しているんじゃないかと。
    FileSystemObjectは良く使用しますが、時間が掛かっても応答なしになったことはありません。
    ※excel vbaで使用したことは少なく、主にvbsやaccess vbaでの話ですが。

    キャンセル

  • 2018/01/30 17:02 編集

    >Dir と DoEvents を同じようなタイミングで繰り返し呼び出す、
    >という事に問題があるということなのでしょうか?
    時間が掛かる処理(応答を待っている処理)でDoevents(応答を要求する)のは、実行不能なのではないでしょうか。別なイベントを消化させるというのなら意味があるかもしれませんが、特に処理は行っていないのでしょうし。
    なので、処理を進めたい処理とは、別なタイミングで行うのが真っ当ではないでしょうか。
    ※今回であればOntimeメソッドなどで。

    キャンセル

+1

プログラムにおいて再帰というのは自身の関数を呼び出すことを言うので、この場合は当てはまらないと思います。
また無限ループという言葉も、ループ処理から抜け出せないことを指すので、これも当てはまらないと思います。
想定外に速い間隔で何回も呼ばれるということでしょうか。
なんとなく1秒経過したらの処理周りが怪しいようにみえます。
Timerというのはなんでしょうか?秒数が入っているのでしょうか?
差が1(秒)を超えていたらという判定文なのに、型がdoubleなのは正しいですか?
実は1ms間隔になっていないですか?

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/30 13:36

    説明しにくいのですが、★箇所で「prDoEvent」が呼ばれ、
    その状況が無限に続くという状況が続きます。

    もっと正確にいうならば、
    ステップ実行で★箇所の次に「Private Function prDoEvent()」
    の行へ進み、それが終わらなくなり、
    本来呼び出されているはずのFor文へ戻らなくなる、
    という表現になります。

    Timer はVBAに備わっている関数で、
    呼ばれた時点のその日の秒数が取得できます。
    詳細はこちらを参照ください。
    https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/timer-function?f=255&amp;MSPPError=-2147217396

    処理回数は計測して確認しましたが、
    間隔は1秒毎で処理されていました。

    型は仰る通り正しくはSingle型のようです。
    訂正して様子をみてみます。
    (ただ、こちらでも稀にしか再現せず、苦戦してます。。。)

    キャンセル

  • 2018/01/30 13:55

    ふむ、時間計測周りは問題ないようですね。
    こちらの知識不足で、逆に勉強になりました。
    提示されているコード範囲では、prDoEvent()を呼び出している箇所は、fDoEvents()のみです。
    他に提示コード外で呼び出している箇所はないのでしょうか?
    非同期で動いている別の処理(イベントなど)から呼ばれているようなことはないのでしょうか?
    もうそれしか考えられません。
    DoEventsを実行することでイベントが動いてしまうのであれば、EnableEvents で制御する手もあります。

    キャンセル

  • 2018/01/30 14:08

    fDoEvents が Public で、prDoEvents はPrivate です。
    さらに、同モジュールには、上記のコードしかないので、
    他からは fDoEvents のみ呼び出されるという状況です。

    フォルダ容量計測処理では、ファイルを回しているループ内で、
    1ループに1回「fDoEvents」を呼んでいるのみです。

    確かにイベント等で何か知らない処理が挟まっている可能性もありますが、
    当ツールは単純な処理のみで、イベント等で処理しているものはない状況です。

    ほんと、困り果てております。。。

    キャンセル

  • 2018/01/30 14:14

    原因究明はお手上げですが、以下参考までに教えてください。
    ・暴走したときというのはどれくらいの間隔でprDoEventsが呼び出されるのでしょうか
    ・暴走したことによって何か弊害があるのでしょうか?(メイン処理側のループに戻らない?)
     暴走してもDoEventsが頻繁に呼びされるだけなので、処理時間は伸びるかもしれませんが、実質処理に影響はないような気がします。
    ・暴走したとき、メイン処理側のループにブレークポイントを置いても止まらないのでしょうか?

    キャンセル

  • 2018/01/30 14:19

    暴走した場合は、該当箇所にブレークポイントを置くと止まりますが、
    処理としては、prDoEvents の無限ループが起こっており、終わらなくなります。
    どれくらいの間隔で、という事に関しては現在調査中です
    (本来は1秒おきに呼ばれるはずなのですが。。。)

    キャンセル

  • 2018/01/30 14:24

    思うに、prDoEvenetsは正常に処理されているように感じます。
    むしろメイン処理側に問題があるのではないでしょうか?
    例えば1から10まで回るFor文があって、その途中でfDoEventsを呼び出している。
    しかし暴走してprDoEventsが何回も呼ばれる。
    しかしFor文は継続して動いており、ブレークポイントで停止する。
    となればFor文の終了条件が満たされず、無限ループしているのではないでしょうか?

    キャンセル

  • 2018/01/30 14:34

    For文に関する関数「fFile_Path_in_Folder」を追記しました。
    すみません、Do Loop 文の間違いでした。

    しかし、ブレークポイントで停止し、その後にステップ実行で処理を進めた際に、
    ★部分の次に「Private Function prDoEvent()」へ移動する、
    という不可解な事象が起こっております。

    次に再現した際、ループ文側でブレークできるか試してみます。

    キャンセル

  • 2018/01/30 14:43

    追記ありがとうございます。
    見た感じ問題なさそうですね。
    謎。

    キャンセル

+1

現象確認できたわけではないので、気になる点だけ。

GetInputStateはキー入力などのイベントが発生すると0以外の値を返す(つまりTRUE条件に入る)ようです。

fDoEventsがループ処理により絶え間なく呼ばれ続けている場合、Timer判定では1秒以上の間隔をあけてprDoEventsを呼び出していますが、GetInputState判定の方は連続してイベントが発生すれば1秒以内でもprDoEventsを繰り返し呼ぶことになりそうです。
これを繰り返すうちにDoEventsが追い付かなくなるなんてことは・・・あるのかどうか。
それが原因で周回遅れのprDoEventsがDoEvents後に発生するなんてことが・・・あるのかどうか。

そもそもVBAは基本的にマルチスレッドもできませんし、割り込み処理が苦手なとこありますよね。。
私の環境ではループ処理でfDoEventsを呼び続けている最中にExcelシート上でセル編集モードに入ると、その時点でもともと動いていたマクロは中断してしまい、あまりアレコレ操作できませんでした(^_^;

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/30 16:26

    ご回答ありがとうございます。

    セルで編集モードにしてしまうと、強制的にマクロが止まってしまうので、
    個人的には「応答なし」のままでいいと思っていたのですが、
    お客さん側から強めの要望でそれは困るということで。。。
    (Excelのウィンドウを動かす等ができない、動いてるのか不安 etc)

    「GetInputState」については、
    外してみても、不具合が再現してしまい、
    そのままにしている状況です。

    キャンセル

0

VBA と VB.NET は別物です。どちらかのタグを外してください。見たところ VB.NET ではないですか?

DoEvents が Application.DoEvents ならここで無限ループはおかしいです。
メッセージによって呼び出されているのでしょうか?
それとも自作関数なのでしょうか?

無限ループと無限再帰は別物です。無限ループは終わりませんが、無限再帰はスタックオーバーフローですぐ終わります。

全体的に問題の前提とデバッグ方法が間違っていてコードも足りません。
これだけの情報では何もわかりません。

実行可能な最小限のソースを提示すれば何かわかることもあるかもしれません。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/30 13:20

    おっしゃる通り、無限再帰であれば終わります。
    説明がしにくいのですが、
    ★部分で再帰的に「prDoEvent」が呼ばれ、
    その状況が無限に続くという状況が起こっています。

    こちらはVBAですが、起こっている状況が不思議すぎるので、
    ひょっとしたら、VB.NET方面の人ならご存じかも、
    藁にもすがる思いでタグを付させて頂きました。

    こちらの環境でも再現できる条件が判明しておらず、
    同じ条件(同フォルダパス、同じファイル数)でも、
    起こる場合と、起こらない場合があり、
    しかも稀に起こるという状況です。

    キャンセル

  • 2018/01/30 13:38 編集

    DoEvents は 正確には Interaction.DoEvents です。
    ※Application は Excel ないし、Word です。

    キャンセル

0

DoEventsをうまく使うのページに、正解と思われるコードが掲載されています。
どのような意図で作ったコードなのか、どのように動作するコードなのかといった判り易い説明がされているので、参考になると思います。
こちらのコードを使ってみては如何ですか?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

本当にprDoEventが再呼び出しされているのなら、処理中フラグを設けてやって、

Dim procFlag as Boolean

Private Function prDoEvent()

    if procFlag then Exit Function

    procFlag = True

    '一定間隔処理用に処理時点の時間を保持
    DoTime = Timer

    '実行 
    DoEvents '★稀に、DoEvents実行直後に「prDoEvent」が呼ばれ、再帰的に呼ばれ続けてしまう

    procFlag = False

End Function


として、すぐに抜ければ良いように思います。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/30 17:48

    ご回答ありがとうございます。
    試してみます。

    キャンセル

0

無限ループにはまる原因は思い当たりませんが、Call fDoEventsの部分を純粋なDoEventsにしてしまえば良いのでは?
こうしてしまえば無限ループにハマる余地はなくなります。
この事例においては関数にするほどのものではないように思えます。
数万回のループならGetInputStateやTimerでの時間計測を入れることで劇的に処理速度が向上しますが、特定フォルダ内のファイル走査程度の繰り返し回数であれば、体感速度としてはそれほど変わらないと思われます。
もちろん、検索対象フォルダ内のファイル数が何千、何万もあるようなケースであれば別ですが。。。

Public Function fFile_Path_in_Folder(Path_Folder As String, _
                                     Optional Extention As String = "*", _
                                     Optional FileAttribute As VbFileAttribute = vbNormal) As Variant


    '- 指定フォルダが無かった場合、終了
    If FSO.FolderExists(Path_Folder) = False Then Exit Function

    'フォルダパスを格納
    Dim Path_FD     As String
    Path_FD = Path_Folder
    If Right$(Path_FD, 1) <> Application.PathSeparator Then
        Path_FD = Path_FD & Application.PathSeparator
    End If

    Dim Dic As Scripting.Dictionary
    Set Dic = New Scripting.Dictionary

    '最初のファイルパスを取得
    'Dir関数に検索パスを設定
    Dim FileName   As String
    FileName = Dir(Path_FD & "*" & "." & Extention, FileAttribute)

    Do While FileName <> ""

        'Call fDoEvents
        DoEvents '←

        Dim Path_File   As String
        Path_File = Path_FD & FileName

        'ファイルパスを辞書に登録
        If Directory_IsFolder(Path_File) = False Then
            Dic.Item(FileName) = Path_File
        End If

        '次のファイルパスを取得
        FileName = Dir()

    Loop

    'ファイルロックの開放(念のため)
    Call Dir(vbNullString)

    If Dic.Count = 0 Then Exit Function

    '- 戻り値
    fFile_Path_in_Folder = Dic.Items

    Set Dic = Nothing

End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/31 12:51

    回答ありがとうございます。

    確かに今の一般的なPCであれば数千程度の処理では不要でしょう。
    しかし、PCのスペックが低い場合や、ファイル数が数万の場合等も考えられます。

    そして最大の問題は『ループ中にDoEventsを呼ぶことによる異常現象』なので、
    ファイルを検索というのは1ケースに過ぎず、
    原因が分からない以上、他ケースのループ処理でも起こりうる、
    と考えられますので、この機会に原因究明・解消できればと思い、
    この場をお借りした次第です。

    キャンセル

同じタグがついた質問を見る

  • VBA

    2377questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • VB.NET

    1072questions

    Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。