エクセルVBA　Dir途中で止まる

Question

DirとWorkbooks.OpenTextを併用し、大量のファイルの開閉をしてます。
ファイル数２千。ファイルの行数は5千行程度。CSVファイル。
出だしは快調で10ファイル/秒程度の速さですが、だんだん遅くなり、１ファイル/５秒程度になり、ついに固まります。最初は問題ありませんでしたが、毎日処理を続け１か月目あたりから発生してます。固まるまでの処理数は、１０００～５００ファイル程度。

単にファイルの開閉だけなのに止まります。なぜでしょう？

Sub Macro()

   TwbPath = ThisWorkbook.Path
    Folder = Cells(1, "A").Value
    buf = Dir(TwbPath & "\" & Folder & "\*.dat")
    Do While buf <> ""
　　    Application.ScreenUpdating = False
        Workbooks.OpenText Filename:=TwbPath & "\" & Folder & "\" & buf, Comma:=True
        Application.DisplayAlerts = False
        Workbooks(buf).Close savechanges:=False
        Application.DisplayAlerts = True
        buf = Dir()
　    Application.ScreenUpdating = True
    Loop

End Sub

ki-aaa · Accepted Answer

こんにちわ

原因は、エクセルでのオーブン・クローズの繰り返しにあると思います。
バイナリで読み込んだらどうなるか
下のコードで試してください。

Sub MacroReadFile_InputB()
    Dim THisBookPath As String, fName As String
    Dim intFF As Long, xFolder As String
    Dim FullFilePass As String
    Dim ByteSjis, strUnicode, valArray
    Dim iRow As Long
    
    Application.ScreenUpdating = False
    THisBookPath = ThisWorkbook.Path
    xFolder = Cells(1, "A").Value

fName = Dir(THisBookPath & "\" & xFolder & "\*.csv")
    Do While fName <> ""
        intFF = FreeFile
        FullFilePass = THisBookPath & "\" & xFolder & "\" & fName
        Open FullFilePass For Input As #intFF
        ByteSjis = InputB(FileLen(FullFilePass), #intFF)  'SJISのテキスト読み込み
        Close #intFF

strUnicode = StrConv(ByteSjis, vbUnicode) 'SJISからUNICODEへ
        valArray = Split(strUnicode, vbCrLf)      '改行コードごとに区切って配列化 '
        iRow = UBound(valArray)                   '行数取得
        
        fName = Dir()
    Loop

Debug.Print strUnicode
    Application.ScreenUpdating = True
End Sub

ママチャリ · Answer

すいません。回答ではないのですが、2点、確認させてください。
まず、「出だしは快調で…だんだん遅くなり…」とのことですが、この時間の測定は、どのように行っているのでしょうか？
次に、「固まる」とは、何をもって固まったと判断されていますか？

何が気になっているのかと云うと、Excelって、”（応答なし）”と表示していても裏で一生懸命処理していて、いつの間にか正常終了していたことがあったので…。
だんだん遅くなるということが正確に測定されているのであれば、疑う余地はないのですが…。

WindFaller · Answer

#1の回答者です。私が、Dataファイルの処理のVBAを覚えたのは古いことですが、その件については、Datファイルをバイナリ処理で位置決めなどした覚えがありますが、#2様も多少触れていますので、その件は、私のほうからは後回しにさせていただくことにします。 Datという拡張子が付く理由なのですが、結局、相手のアプリ側の出力の問題だったりすることが多いわけで、Text なら.Txt もしくは、拡張子なしで出力させていたります。マクロに掛ける前に、私などは、バイナリエディタやNotePad++ で内部を調べていることが多いです。ファイル構造のサンプルでもあれば、こちらでも、厳密に調べたいと思います。 (1) DoEvents 「https://oshiete.goo.ne.jp/qa/8750372.html」をご覧になったかもしれませんね。DoEvents は、ループの中に入れて、VBAの命令が受け付けない状態から復帰させるコードですね。それと、 Application.DisplayAlerts = False Application.DisplayAlerts = True これは何か問題が出ていましたか？一度外して、Doeventsを代わりにいれてみたらどうでしょうか。(以下　Macro2を参照) (2) 問題点か？私が自分で書き直しみて、気がついた点がいつくかあります。 Sub Macro2() 　Dim Bk As Workbook 　Dim FName As String 　Dim buf As String 　　Dim TwbPath As String 　Folder = ActiveSheet.Cells(1, "A").Value 　TwbPath = ThisWorkbook.Path &"\" & Folder 　buf = Dir(TwbPath & "*.csv") 　Do While buf <> "" 　　Application.ScreenUpdating = False 　　FName = TwbPath & "\" & buf 　　Workbooks.OpenText Filename:=FName, Comma:=True　'①ここでオブジェクトが取れない。理由は分析しているからだそうですが。 ''　--略-- 　　DoEvents 　　WorkBooks(buf).Close SaveChanges:=False　'②　ここで手間がかかっている　　buf = Dir() 　　Application.ScreenUpdating = True 　Loop End Sub '// (2) -1 ここから考えられることは、「Workbooks.OpenText」を他のものに変えてみる。データ(タブ)--外部データの取り込み-テキストファイル　　|| VBA では、その等価のQueryTable を使います。ただし、出来上がったQueryTable 面倒ですが、 ActiveSheet.QueryTables(1).Delete とか、最後に置かなくてはなりません。 (2)-2 QueryTable でも同じことですが、新規のワークブックひとつで、書いたり消したりする。単に計算するための場所として、以下を繰り返す　FNo = FreeFile() 　i = 1 　Open Fname For Input As #FNo 　Do While Not EOF(FNo) 　　Line Input #FNo, TextLine 　　If TextLine <> "" Then 　　arBuf = Split(TextLine, ",") 　　Cells(i, 1).Resize(, UBound(arBuf) + 1).Value = arBuf 　　DoEvents 　　arBuf = "" 　　i = i + 1 　　End If 　Loop 　Close #FNo こうしたImport メソッドを利用してみる。集計が終わったら、ActiveSheet.UsedRange.Clear や ActiveSheet.Cells.Clear としてしまいます。(究極的には、シートに出さなくても、コードでも可能なはずです) 文中の手間がかかるには、2つの意味があります。・オブジェクトの生成と削除の処理に、オーバーヘッドが掛かる。・VBAコードの実行で、物理的処理が伴うために、リターンコードの発行に時間が掛かる。 3. >WorkBooks(buf).Close SaveChanges:=False この後、次のステップにかかる前に、Sleepを入れてみる。モジュール一番上に Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) とおくものですが、ご存知だと思います。時間は適当ですが、500 ms ぐらいか？ 4. メモリリークの検査は専門的ですから、これも後に回したほうがよいかもしれません。 // #2様のUnicodeの話は、時間の許す限りは検証したいと思います。前年にUnicode(UTF-16 B付き,Bなし、Little Endian, Big Endianなど)散々ここらのあたりは、様々なコードで試したものの、なかなか難しくて、途中で保留にしてしまいました。

WindFaller · Answer

こんにちは。

私には経験はありませんが、その状況は、メモリー・リークを起こしている状態に似ています。今、私のところでは解決の目処があるわけではありませんが、

*.dat

とは、内容にもよりますが、Excelで扱う.datファイルは、基本的には、Textファイルに非常に似ていますが、バイナリを含んでいたりしますので、OpenTextで開いても、終了時には、Excelのメモリに一部を残してしまっているものだと思います。

そのマクロが始まった時から、止まるまでの時、タスクマネージャのメモリ状態の変化などを最初に調べてみるところから始まると思います。
Microsoft には、様々ツールがありますし、もし、現行のタスクマネージャで足りない場合は、Microsoft Process Explorer もあります。

メモリリークを調べるRAMMap というのもあるそうです。

しかし、結局のところ、datファイルを開くためのマッチングを図らないといけないでしょう。

".dat" の拡張子は、汎用性だとは言われますが、Excelで扱うときには決まったものが存在します。ご質問のマクロは、ファイルの開け閉めで、最終的には何をしているのでしょうか？Viewer(ヴューワー) のようでもあるし、そうでないのかもしれません。何かを検索しているようなプログラムにも思えます。

その目的によっては、まったく別な方法を考えてもよろしいのかもしれませんね。

なお、現状のままで処理する場合というか、私の場合は、Dir 関数で予めファイル名を配列変数に入れて、その取得したリストでもって、ファイルをIn/Out することが多いです。Dir 関数は、次のループのDir 関数に別な仕事をすると、何かおかしな動きをすることがあります。今回は、まったく関係がないのかもしれません。暗中模索の状態です。

エクセルVBA Dir途中で止まる

こんにちわ

すいません。

#1の回答者です。

こんにちは。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセルVBA　Dir途中で止まる