こんにちは
以前も質問させていただいたのですが、再帰処理が上手くいかないので教えてください。
フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を
取得いたいのですが、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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Excel(エクセル) VBA フォルダ見える化のコードについて 2 2023/06/19 15:04
- Visual Basic(VBA) あるフォルダーのファイルを違う親フォルダーのサブフォルダーに移したい 11 2023/02/15 19:00
- Visual Basic(VBA) VBA 参照先で選んだファイルをコピーし、出力先に別名で保存したい 8 2022/05/13 20:37
- JavaScript プログラムがうまく動きませんレビューお願いします 1 2022/07/10 05:08
- JavaScript javascriptのちょっとした動作不良(原因は突き止めたのですが) 1 2023/06/15 19:58
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/06 17:46
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
ファイル名と同名のフォルダを...
-
EXPLORERで開いているフォルダ...
-
C ファイル出力で、フォルダが...
-
ファイル名から該当フォルダへ移動
-
VBA:特定の文字を含むフォルダ...
-
多量のファイルをフォルダに自...
-
サーバ内のフォルダ名と各フォ...
-
条件に合うフォルダが存在する...
-
パス名に2バイト文字(マルチバ...
-
カレントフォルダって?
-
Excel VBA 同じ名前のフォルダ...
-
フォームを最前面に表示したい...
-
フォルダ配下のファイル作成日...
-
Hitachi Embedded Workshop (HE...
-
vbsで選択ダイアログを表示した...
-
VS2005で"定義へ移動"ができません
-
VBA フォルダ名に特定の文字を...
-
バッチファイルで指定フォルダ...
-
フォルダ内のPDFファイル名を変...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
パス名に2バイト文字(マルチバ...
-
ファイル名と同名のフォルダを...
-
VBA 最新のフォルダ取得
-
Excelのハイパーリンクについて...
-
デスクトップの画像をhtmlに表...
-
ディレクトリ名変更してコピー...
-
VBA フォルダ名に特定の文字を...
-
バッチファイルで指定フォルダ...
-
フォルダ内のPDFファイル名を変...
-
Access VBA で フォルダ権限...
-
excelマクロ 冒頭3文字が一致す...
-
【マクロ】ファイル名の日付に...
-
フォルダにリンクを貼りたい
-
会社のネットワーク上のファイ...
-
多量のファイルをフォルダに自...
-
C ファイル出力で、フォルダが...
-
保存先のフォルダ名を指定した...
-
vbsで選択ダイアログを表示した...
-
Excel VBA 同じ名前のフォルダ...
おすすめ情報