VBScript再帰処理について
- VBScriptの再帰処理がうまくいかない場合について質問です。
- フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を取得したいですが、再帰処理で「Out of memory」となります。
- 参照ファイルのファイル名と参照フォルダ内のファイル名を比較し、一致しているファイルを保存先フォルダにコピーしたいです。
- ベストアンサー
VBScript 再帰処理について
こんにちは 以前も質問させていただいたのですが、再帰処理が上手くいかないので教えてください。 フォルダ指定ダイアログで取得したフォルダのサブフォルダ内のファイル名を 取得いたいのですが、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>
- k1227_001
- お礼率47% (8/17)
- Visual Basic
- 回答数3
- ありがとう数1
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
disp2.value = fsoFile.Nameとしてますが これだと常に一番最後に検索されたファイル名だけになると思います disp2.value = disp2.value + fsoFile.Name + vbCrLf と言った具合にしないと追加されてはいかないでしょう disp1に関しても同じことが言えると思いますよ
その他の回答 (2)
- redfox63
- ベストアンサー率71% (1325/1856)
ネットワーク共有されたフォルダーでも可能ですよ パスワード保護がある場合は先に人間さんが接続してからなら上手くいくようです 自動化も可能だったはずですが ちょっと資料が見つかりませんでした m(__)m
お礼
redfox63さん こんばんわ。調べていただいてありがとうございます。 エラーの「パスが見つかりません」と指定箇所のSet fsoFolder = objFso.GetFolder(inFolderName)で調べてみます。 ローカルでは動いているので、先に参照ファイルで取得したファイル名 と参照先フォルダから取得したファイル名を検査して一致したものを 保存先フォルダにコピー、一致しないファイル名をテキストで保存先に 出力というのを考えてみます。 If objFso.FolderExistsで躓いていますが、がんばってみます。
- redfox63
- ベストアンサー率71% (1325/1856)
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
- VBScriptでのファイルコピー
こんにちは いつもお世話になります。 現在、「ファイルの指定ダイアログ」で選択されたファイルの中身（ファイル名） と「フォルダ指定ダイアログ（参照先）」で選択されたフォルダ（サブフォルダ含む） 内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ （保存先）」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ （保存先）」に出力するというツールを作成しています。 以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます でしょうか。 宜しくお願い致します。 ---------------------------------------------------------------------- <html><head> <script language="VBScript"> 'Call Window.ResizeTo(500,200) Set objFso = CreateObject("Scripting.FileSystemObject") 'テキストファイル吐き出し場所 Const LIST_FILE = "C:\Documents and Settings\All Users\デスクトップ\NonFile.txt" '色々宣言 Dim objFso Dim inFolderName Dim outFolderName Dim inFileName Dim objTxIn Dim ListFile Dim CurrentFileName '色々定数 Const TristateTrue = -1 Const TristateFalse = 0 Const TristateUseDefault = -2 Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 '参照フォルダをテキストに表示 '------------------------------------------------------------ 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 outFolderName = ofd.value If objFso.FileExists(inFileName) = True Then Set ListFile = objFso.OpenTextFile(inFileName,ForReading,false,TristateTrue) 'ファイルが無いとき Else MsgBox("ファイルが選択されていません。") End If Call iFolder(inFolderName) MsgBox("完了") End Sub 'サブフォルダ内ファイル検査→有 コピー/無 テキスト出力 '------------------------------------------------------------ Sub iFolder(inFolderName) CurrentFileName="" 'フォルダオブジェクト取得 outFolderName = ofd.value If inFolderName ="" then inFolderName = ifd.value Set fsoFolder = objFso.GetFolder(inFolderName) On Error Resume Next CurrentFileName = ListFile.ReadLine For Each fsoFile In fsoFolder.Files If fsoFile.Name = CurrentFileName Then fsoFile.Copy outFolderName,CurrentFileName,false Else set NoFile = objFso.CreateTextFile(LIST_FILE,True) NoFile.WriteLine(CurrentFileName) NoFile.Close End If fsoFile.Close Set fsoFile = Nothing Next For Each fsoSubFolder In fsoFolder.SubFolders Call iFolder(fsoSubFolder) Next End Sub </script> </head>
- 締切済み
- Visual Basic
- ファイルを探すプログラムで c:\のみ動かない
ファイルを探すプログラムをネット頂き テストしたのですが c:\ のみ 動かず c:\*** は そのフォルダーから下を探します e:\ は 全てのフォルダーを探します。 ＷＩＮ８ ですが どこで間違ってるのでしょうか？ よろしくどうぞ Option Explicit Private g_dteDate As Date Private g_strEXT As String '参照設定 M-Scripting.Runtime Cells(1, 2).Value に 探すアドレス 記載 c:\ e:\ c:\*** など Sub Sample_FileSearch2() Dim vntF As Variant Dim objFSO As FileSystemObject Dim dteDate As Date Dim GYO As Long Dim cntFound As Long Set objFSO = New FileSystemObject ' FSO Rows("5:65536").ClearContents GYO = 4 ’ g_dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date) 更新 不要 g_strEXT = UCase(Trim(Cells(2, 2).Value)) ' ルートフォルダから探索開始 Call Sample_FileSearch2_SUB(objFSO, _ objFSO.GetFolder(Trim(Cells(1, 2).Value)), GYO, cntFound) Set objFSO = Nothing ' 処理結果の表示 If cntFound = 0 Then MsgBox "見つかりません" Else MsgBox cntFound & "個見つかりました" End If End Sub '''******************************************************************************* ''' ファイル探索処理(再帰動作) '''******************************************************************************* Private Sub Sample_FileSearch2_SUB(objFSO As FileSystemObject, _ ByVal objFolder As Folder, _ GYO As Long, cntFound As Long) Dim objFolder2 As Folder Dim objFile As File ' サブフォルダの探索 For Each objFolder2 In objFolder.SubFolders ' サブフォルダ個々の探索(再帰動作) Call Sample_FileSearch2_SUB(objFSO, objFolder2, GYO, cntFound) Next objFolder2 ' このフォルダ内のファイルの探索 For Each objFile In objFolder.Files ' ここから条件判断 With objFile If (UCase(objFSO.GetBaseName(.Path)) = g_strEXT) Then GYO = GYO + 1 Cells(GYO, 1).Value = .Name Cells(GYO, 2).Value = .DateLastModified Cells(GYO, 3).Value = _ Left(.Path, Len(.Path) - Len(.Name) - 1) cntFound = cntFound + 1 End If End With Next objFile End Sub
- ベストアンサー
- Visual Basic
- VBScriptでフォルダ参照ダイアログを表示したい
HTMLファイルの中にVBScriptを記述しています。 内容はボタンが押されたら、フォルダ参照のダイアログ ボックスを表示したいのです。 開発環境は windows2000 IE6.02 スクリプトのところは以下のように記述しています。 Function Getfolder() Set Shell = CreateObject("Shell.Application") Set objFolder = Shell.BrowseForFolder(0, "フォルダを選択してね！", 1) if objFolder is Nothing then Msgbox("フォルダを選択してください") else Msgbox(objFolder.Items.Item.Path) end if End Function で、Set objFolder = Shell.BrowseForFolder(0, "フォルダを選択してね！", 1) のところで「書き込みできません」のエラーが表示されてしまいます。 どのようにすればフォルダ参照のダイアログボックスを表示できるのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- VBScriptでのフォルダ指定ダイアログについて
VBSciptでの「フォルダ指定ダイアログ」について教えてください。 「フォルダ指定ダイアログ」を利用して、保存元のフォルダと保存先の フォルダを選択し、特定ファイル(*.jpg)のコピーをするツールを作っています。 下記のプログラムで、「フォルダ指定ダイアログ」が表示されるのは 確認できたのですが、選択したフォルダの階層をテキストフォームに 表示させる方法を教えてください。（書き込みできませんのエラーになります。） --------------------------------------------------------- Dim objShell Dim objFolder ' オブジェクトの生成 Set objShell = CreateObject("Shell.Application") ' フォルダ選択ダイアログを表示 Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください。", 0) Set objShell = Nothing --------------------------------------------------------- 以上、宜しくお願い致します。
- ベストアンサー
- Visual Basic
- vbsでのエラー処理についてレクチャーを
vbsのcopyhere関数でファイルのコピーを行うスクリプトを作成しました。コピー自体は問題なく出来るのですが、コピー元のファイルが存在しなかった場合は何も実行されないまま次の処理へ行ってしまうので、そういう場合にエラー用の処理をさせたいと考えてます。 Errメソッド使えばいいと思うのですがうまくいかなかったのでご教授ください。 試しに作成したvbs----------------------------------------- On Error Resume Next Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.NameSpace(strTargetFolder) 'コピー先フォルダの設定 objFolder.CopyHere strCopyFile , &H10 ' set objShell = Nothing 'コピーが失敗した場合に実行させる。 if Err.Number <> 0 Then MsgBox "インストーラーをコピーできませんでした。","コピーに失敗しました" WScript.Quit end if ↓正常にコピー完了した後の処理 これでは上手くいきませんでした。 どうすればエラー時の処理を追加できるでしょうか？
- 締切済み
- Windows XP
- エクセルのデータからフォルダを作成
エクセル選択・読み込み→フォルダ作成先指定・処理 →作成した空のフォルダを表示 という手順のプログラムです。 コモンダイアログで選んだエクセルのデータを元に、 新しいフォルダを作成したいと思っています。 エクセルには番号（一列目）、氏名（二列目）などが入っており 一人分の情報が一行目に、二人目の情報が二行目・・・という風に一行ずつに入っています。 指定した作成先に、そのエクセルで読み込んだ人数分だけ 空のフォルダを作成し、なおかつ一列目に入っていた番号を フォルダ名にしたいのですが、どうすればいいでしょうか。 途中まで作ってみましたが後が続きません。 よろしくお願いします。 Private Const BIF_RETURNONLYFSDIRS As Long = &H1 Dim objShell As New Shell Dim objFolder As Folder Private Sub Command1_Click() Set objShell = New Shell Set objFolder = objShell.BrowseForFolder(Me.hWnd, "フォルダを選択してください", BIF_RETURNONLYFSDIRS) If objFolder Is Nothing Then MsgBox "ファイルを開く作業をキャンセルします" Else End If Set objShell = Nothing End Sub
- ベストアンサー
- Visual Basic
- VBSのGetFolderメソッドについてですが
VBSで質問です。環境はXP Proです。 GetFolderメソッドでFolderオブジェクトを取得し、Filesプロパティを For Eachでチェックしている時に、フォルダ内ファイルが削除された場合は、例外処理が起こるのでしょうか？ それとも、削除処理自体が排他制御されてしまうのでしょうか？ －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' 環境設定 Const strRootPath = "D:\" '監視対象フォルダ Dim objFso,objFolder,objFile,count Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFso.GetFolder(strRootPath) count = 0 ' メインスクリプトの実行開始 For Each objFile In objFolder.Files ' このタイミングでファイルが削除されてしまったら？ If objFso.GetExtensionName(objFile) = "txt" Then count = count + 1 End If Next 皆様のお知恵をお貸しください。
- ベストアンサー
- Visual Basic
- VBScriptの繰り返し文について
こんにちは。下のスクリプトでクリックボタンをクリックすると、サブフォルダ名が表示されるようにしたいのですが、どこのクリックボタンをクリックしても、一番下のサブフォルダの名前が表示されてしまいます。何かいい方法はあるでしょうか。よろしくお願いいたします。 <html><head> <title>test</title> </head> <body> <h3>サブフォルダ一覧</h3> <table border> <tr><td>サブフォルダ名</td><tr> <script language=VBScript> <!-- Option Explicit Dim FSO Dim TestFolder Dim F Dim X set FSO = CreateObject("Scripting.FileSystemObject") Set TestFolder = FSO.GetFolder(".").ParentFolder For Each f IN TestFolder.SubFolders X = f.name Document.Write "<tr><td> " & X & " </td></tr><td><input type=button onclick=setnum value=クリック></td></tr>" Next Sub setnum msgbox X End Sub Set FSO = Nothing Set TestFolder = Nothing --> </script> </table> </body></html>
- ベストアンサー
- その他（プログラミング・開発）
- WSH_フォルダ内の処理について
昨日から作成しているのですが、 新しく質問を立ち上げます。 下記のように、フォルダ内に格納してあるファイルを 取得できるのですが、フォルダ内で作成日時を見て 最新のファイル以外は削除させたい処理をやりたいです。 ファイル名を明示的に記載し比較はできるのですが、 フォルダ内の中から作成日時の最新のファイルを取得する っていうのができません。 下記ソースはイメージです。 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\test") For Each objFile In objFolder.Files If objFile.type = ファイルタイプ Then 上記ファイルタイプで最新の日付のファイルを出力 上記ファイル以外削除 Else 上記ファイルタイプが存在しなければ何も処理を行わないず フォルダ内のファイル一覧を取得 WScript.Echo " " & objFile.Name Wscript.Echo "NG" End If Next 調べているのですが、簡単なソースしか作れません。 お願いします
- ベストアンサー
- その他（プログラミング・開発）
- Desktopのファイルを別フォルダにコピーしたい
Desktop上のあるZIPファイル（例；zzz.zip）を別のフォルダ（例；DドライブのFolder1）にコピーして解凍する場合、下記のVBSで実行できると思いますが、これをDesktopの階層が異なる（後述の xxxxx）不特定多数のPCで実施する場合、実行できない場合があります。 このためDesktopの階層が左右されないScriptにしたいのですが、模範Scriptを教えていただけないでしょうか。DesktopPathなどで対応すればできるのでは、と思いますが、なかなかうまくいきません。 使用PCのOSはWindows7（32ビット）です。 '------------------------------------------------------------- DIR_Source = "C:\xxxxx\Desktop\zzz.zip" DIR_Destination = "D:\Folder1" Const FOF_Silent = &H04 Const FOF_NoConfirmation = &H10 Set objShell = CreateObject("Shell.Application") Set FilesInZip = objShell.NameSpace(DIR_Source).items Set objFolder = objShell.NameSpace(DIR_Destination) If (Not objFolder Is Nothing) Then objFolder.CopyHere FilesInZip, FOF_NoConfirmation + FOF_Silent End If
- ベストアンサー
- Visual Basic
補足
redfox63 さん ありがとうございます。サブフォルダの中身も表示できました。 初歩的な質問で申し訳ありませんが、共有サーバ内にあるフォルダを指定した 際には「パスが見つかりません」とのことでルートディレクトリ内のファイル名 しか取得できませんでした。 今の記述方法では、ローカルマシンでし動作しないのでしょうか？ 以上、宜しくお願い致します。