プロが教えるわが家の防犯対策術!

こんにちは

以前も質問させていただいたのですが、再帰処理が上手くいかないので教えてください。

フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を
取得いたいのですが、Sub iFolder(inFolderName)内の inFolderName = ifd.valueの
部分で「Out of memory」となってしまいます。

参照ファイル内のファイル名と参照フォルダ(サブフォルダ含む)内の
ファイル名を比較して一致しているファイルを保存先フォルダにコピー
/一致しないファイル名をテキストで出力をいうことをしたいと思っています。

参照ファイルの中身は「123.jpg」や「456.JPG」などのファイル名だけになります。

以上、宜しくお願い致します。

<html>
<head>
<title>テスト</title>
<HAT:APPLCATION BORDER="dialog" SCROLL="no" ICON="app.ico">

<script language="VBScript">
'Call Window.ResizeTo(500,200)

'参照フォルダをテキストに表示
sub inFolder()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder( _
0, "フォルダを選択してください", 0, "ssfDeskTop")
If objFolder Is nothing Then
'MsgBox("フォルダを選択されませんでした。")
Else
pathFolder = objFolder.Items().Item().Path
ifd.value = vbCr & pathFolder
Set objFolder = nothing
End If
End sub

'保存先フォルダの選択
sub outFolder()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder( _
0, "フォルダを選択してください", 0, "ssfDeskTop")
If objFolder Is nothing Then
'MsgBox("フォルダを選択されませんでした。")
Else
pathFolder = objFolder.Items().Item().Path
ofd.value = vbCr & pathFolder
Set objFolder = nothing
End If

End sub


'テキストファイル読込-------------------------------------------

Sub btn_onClick

'ファイルの有無チェック
txOut=""
inFileName = inFile.Value
Set objFso = CreateObject("Scripting.FileSystemObject")

If objFso.FileExists(inFileName) = True Then
'書き出し処理
Set objTxIn = objFso.OpenTextFile(inFileName)
Do Until objTxIn.AtEndOfStream = True
txDisp = objTxIn.ReadLine()
txOut = txOut & txDisp & vbCr
Loop
disp1.value = txOut
'ファイルが無いとき
Else
MsgBox("ファイルがありません")
End If
call iFolder(inFolderName)
End Sub

'サブフォルダ読込-------------------------------------------
Sub iFolder(inFolderName)
Dim fsoFolder
Dim fsoSubFolder
Dim fsoFile


inFolderName = ifd.value
Set objFso = CreateObject("Scripting.FileSystemObject")


'フォルダオブジェクト取得
Set fsoFolder = objFso.GetFolder(inFolderName)

'フォルダ内/ファイルループ
For Each fsoFile In fsoFolder.Files
'ログに出力
disp2.value = fsoFile.Name
Next

'フォルダ内/サブフォルダループ(サブフォルダが不要なら、このループは不要)
For Each fsoSubFolder In fsoFolder.SubFolders
'サブフォルダで再帰
Call iFolder(fsoSubFolder)
Next
End Sub

</script>

</head>

<body>

参照ファイル:
<input type="file" id="inFile" size="40">


<br />
参照フォルダ:
<input type="text" id="ifd" size="40">
<input type="button" id="fd1" value="参照..">

<script for="fd1" event="onClick" language="VBS">
call inFolder()
</script>

<br />
保存フォルダ:
<input type="text" id="ofd" size="40">
<input type="button" id="fd2" value="保存.." >

<script for="fd2" event="onClick" language="VBS">
call outFolder()
</script>
<br />

<input type="button" id="btn" value="表示">

<br />

<textarea name="disp1" cols="30" wrap="virtual" rows="20"></textarea>
<textarea name="disp2" cols="30" wrap="virtual" rows="20"></textarea>

</body>
</html>

A 回答 (3件)

disp2.value = fsoFile.Nameとしてますが これだと常に一番最後に検索されたファイル名だけになると思います



disp2.value = disp2.value + fsoFile.Name + vbCrLf
と言った具合にしないと追加されてはいかないでしょう

disp1に関しても同じことが言えると思いますよ

この回答への補足

redfox63 さん

ありがとうございます。サブフォルダの中身も表示できました。

初歩的な質問で申し訳ありませんが、共有サーバ内にあるフォルダを指定した
際には「パスが見つかりません」とのことでルートディレクトリ内のファイル名
しか取得できませんでした。

今の記述方法では、ローカルマシンでし動作しないのでしょうか?

以上、宜しくお願い致します。

補足日時:2007/11/06 16:44
    • good
    • 0

ネットワーク共有されたフォルダーでも可能ですよ


パスワード保護がある場合は先に人間さんが接続してからなら上手くいくようです

自動化も可能だったはずですが ちょっと資料が見つかりませんでした
m(__)m
    • good
    • 0
この回答へのお礼

redfox63さん

こんばんわ。調べていただいてありがとうございます。
エラーの「パスが見つかりません」と指定箇所のSet fsoFolder =
objFso.GetFolder(inFolderName)で調べてみます。

ローカルでは動いているので、先に参照ファイルで取得したファイル名
と参照先フォルダから取得したファイル名を検査して一致したものを
保存先フォルダにコピー、一致しないファイル名をテキストで保存先に
出力というのを考えてみます。

If objFso.FolderExistsで躓いていますが、がんばってみます。

お礼日時:2007/11/06 23:44

iFolderの引数 inFolderNameにifd.valueを毎回代入してしまっては同じフォルダーを参照してしまうことになりませんか



したがって再帰で呼び出されても inFolderNameは無視され常にifd.valueで検索を掛けているため 無限ループになって メモリーが足りなくなるのだと思います

この1行をコメントアウトしてみましょう
または
if inFolderName ="" then inFolderName = idf.value
と言った具合にするかですが …

この回答への補足

redfox63 さん

ありがとうございます。
'inFolderName = ifd.value をコメントアウトした場合、プロシジャーの呼び出し、
または、引数が不正です。とエラーになってしまいます。

また、お教えいただきました「if inFolderName ="" then inFolderName = ifd.value」を
追加するとエラーは表示されせんが「Thumbs.db」のみ表示され、サブフォルダ内のファイル名の
取得はできませんでした。

他に何か方法がないか教えていただけますでしょうか。

宜しくお願い致します。

補足日時:2007/11/06 15:19
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!