ここから本文です

デバックの回避方法をおしえてください! 「スタック領域が不足しています」と出...

mac********さん

2019/3/1209:50:02

デバックの回避方法をおしえてください!
「スタック領域が不足しています」と出ます。

Option Explicit

Sub setFileList(searchPath)
Dim startCell As Range
Dim maxRow As Long
Dim maxCol As Long

Set startCell = Cells(5, 2) 'このセルから出力し始める
startCell.Select

'シートをいったんクリア
maxRow = startCell.SpecialCells(xlLastCell).Row
maxCol = startCell.SpecialCells(xlLastCell).Column
Range(startCell, Cells(maxRow, maxCol)).ClearContents

Call getFileList(searchPath)
startCell.Select
End Sub

Sub getFileList(searchPath)

Dim FSO As New FileSystemObject
Dim objFiles As File
Dim objFolders As Folder
Dim separateNum As Long

'サブフォルダ取得
For Each objFolders In FSO.GetFolder(searchPath).SubFolders
Call getFileList(objFolders.Path) ’デバックはここを指します。
Next

'ファイル名の取得
For Each objFiles In FSO.GetFolder(searchPath).Files
separateNum = InStrRev(objFiles.Path, "\")
'セルにパスとファイル名を書き込む
ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
ActiveCell.Offset(1, 0).Select
Next

End Sub


指定したフォルダのファイルパスとファイル名を取得するプログラムですが、
フォルダ数、ファイル数が多いからなのか、デバックが出るようになりました。
1000ファイルくらいまでは出ていたのですが、。。。
格納しているフォルダはファイルはおおよそ1300で、調べたら「多すぎる、深すぎる」
ようでした。

また、指定しているフォルダに謎の無名フォルダがあり、
それを開くと指定フォルダと同じものが入っていて
その無名フォルダを削除すると指定ファルダが削除されました。
原因はこれでしょうか…?

添付の画像が指定フォルダ内で先頭が無名ファイルです。
削除しようとしたら「このファイルは空ではありません。」
と出ました。(無視して消したら指定フォルダごと消えました。)

どなたか助けてください。。
よろしくお願いします。

searchPath,objFiles.Path,xlLastCell,Sub setFileList,デバッグ,objFile.Path,Dir.txt&quot

閲覧数:
96
回答数:
3
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

els********さん

2019/3/1209:54:49

スタック領域があふれる原因は主にふたつです。
①関数内に非常に大きい変数(領域)を取っている。
②再帰的呼び出し(自分で自分を呼び出している)が何回も多く行われる。

あなたの場合、②に該当すると思いますので、間違っていないか、ロジックを吟味し直すなどしてください。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

bch********さん

2019/3/1602:56:36

再帰呼び出しをしない構造に変えましょう。

フォルダの走査順は元のプログラムとは異なります。

Sub getFileList(searchPath)

Dim FSO As New FileSystemObject
Dim objFile As File
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim separateNum As Long

Dim folderList As Collection
Set folderList = New Collection

folderList.Add FSO.GetFolder(searchPath)

Do While folderList.Count > 0
Set objFolder = folderList(1)
folderList.Remove 1

'ファイル名の取得
For Each objFile In objFolder.Files
separateNum = InStrRev(objFile.Path, "\")
'セルにパスとファイル名を書き込む
ActiveCell.Value = Left(objFile.Path, separateNum - 1)
ActiveCell.Offset(0, 1).Value = Right(objFile.Path, Len(objFile.Path) - separateNum)
ActiveCell.Offset(0, 2).Value = FileDateTime(objFile.Path)
ActiveCell.Offset(0, 3).Value = Format((FileLen(objFile.Path) / 1024), "#.0")
ActiveCell.Offset(1, 0).Select
Next

'サブフォルダ取得
For Each objSubFolder In objFolder.SubFolders
folderList.Add objSubFolder
Next
Loop

End Sub

lgk********さん

2019/3/1600:13:03

GetFolder にはそのような欠点があったのですね。
GetFolder を使っている以上、どうにもならないと思います。
GetFolder を使わない方法です。
Pathの中身は変更して下さい。
'
Option Explicit
' 一時停止
Declare Sub Sleep Lib "kernel32.dll" ( _
    ByVal vKey As Long)
'
Sub Macro1()
'
    Const Path = "C:\Users\MA\Desktop\My Documents\質問解答"
    Dim Row As Long
    Dim PathData As String
    Dim FileData As String
    Dim Length As Long
'
    Shell "Cmd /C Dir """ & Path & """ /B /S > Dir.txt"
    
    Sleep 1000
    Range("B5:D" & Rows.Count).ClearContents
'
    While Row <> FileLen("Dir.txt")
        Row = FileLen("Dir.txt")
        Sleep 100
    Wend
'
    Row = 5
    Open "Dir.txt" For Input As #1
'
    While Not EOF(1)
        Line Input #1, FileData
        Length = FileLen(FileData)
'
        If Length > 0 Then
            Cells(Row, "B") = FileData
            Cells(Row, "C") = FileDateTime(FileData)
            Cells(Row, "D") = Round(Length / 1024, 1)
            Row = Row + 1
        End If
    Wend
    Close
    Kill "Dir.txt"
End Sub

残念ながら、あなたの上げたプログラムは、私のパソコンでは動きませんでした。
だから、展開方法はこれであっているかどうかわかりません。
違っていたら書いて下さい。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる