
こんにちは
以前も質問させていただいたのですが、再帰処理が上手くいかないので教えてください。
フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を
取得いたいのですが、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>
No.2ベストアンサー
- 回答日時:
disp2.value = fsoFile.Nameとしてますが これだと常に一番最後に検索されたファイル名だけになると思います
disp2.value = disp2.value + fsoFile.Name + vbCrLf
と言った具合にしないと追加されてはいかないでしょう
disp1に関しても同じことが言えると思いますよ
この回答への補足
redfox63 さん
ありがとうございます。サブフォルダの中身も表示できました。
初歩的な質問で申し訳ありませんが、共有サーバ内にあるフォルダを指定した
際には「パスが見つかりません」とのことでルートディレクトリ内のファイル名
しか取得できませんでした。
今の記述方法では、ローカルマシンでし動作しないのでしょうか?
以上、宜しくお願い致します。
No.3
- 回答日時:
ネットワーク共有されたフォルダーでも可能ですよ
パスワード保護がある場合は先に人間さんが接続してからなら上手くいくようです
自動化も可能だったはずですが ちょっと資料が見つかりませんでした
m(__)m
redfox63さん
こんばんわ。調べていただいてありがとうございます。
エラーの「パスが見つかりません」と指定箇所のSet fsoFolder =
objFso.GetFolder(inFolderName)で調べてみます。
ローカルでは動いているので、先に参照ファイルで取得したファイル名
と参照先フォルダから取得したファイル名を検査して一致したものを
保存先フォルダにコピー、一致しないファイル名をテキストで保存先に
出力というのを考えてみます。
If objFso.FolderExistsで躓いていますが、がんばってみます。
No.1
- 回答日時:
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」のみ表示され、サブフォルダ内のファイル名の
取得はできませんでした。
他に何か方法がないか教えていただけますでしょうか。
宜しくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ファイル名と同名のフォルダを...
-
Windows10でコマンドプロンプト...
-
ExcelのVBAでフォルダ指定がで...
-
フォルダ内のファイルの作成日...
-
Excel VBA マクロ リストボックス
-
会社のネットワーク上のファイ...
-
【マクロ】ファイル名の日付に...
-
C言語でのフォルダ作成
-
C ファイル出力で、フォルダが...
-
VBA フォルダ名に特定の文字を...
-
ツリービューを使って、エクス...
-
VBScriptでのフォルダ指定ダイ...
-
ExcelVBAでフォルダへのハイパ...
-
[VBS] Unicodeの文字化けを防ぎ...
-
excel VBA Dirにて検索したフォ...
-
VBSでファイル名と同じフォルダ...
-
エクセルのデータをメモ帳に貼...
-
レイアウトが崩れてしまいます、、
-
エクセル マクロで指定フォル...
-
Excel VBA マクロ フォルダ名を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA 最新のフォルダ取得
-
デスクトップの画像をhtmlに表...
-
ファイル名と同名のフォルダを...
-
会社のネットワーク上のファイ...
-
ExcelのVBAでフォルダ指定がで...
-
Excelで指定したフォルダに保存...
-
VBA フォルダの複数選択ができない
-
【マクロ】ファイル名の日付に...
-
VB.NRT FolderBrowserDialogを...
-
【マクロ】フォルダにファイル...
-
ThisWorkbookがあるフォルダ更...
-
ディレクトリ名変更してコピー...
-
(C#)フォルダを指定するダイ...
-
VB6で7-ZIPのAPIを使用した圧縮...
-
VBプロジェクトでのフォルダ構...
-
パス名に2バイト文字(マルチバ...
-
Debug フォルダは消していいの?
-
フォルダにリンクを貼りたい
-
フォルダAから1つのファイルだ...
おすすめ情報