VBSのGetFolderメソッドでフォルダ内のファイルが削除された場合の例外処理について
- VBSのGetFolderメソッドでフォルダ内のファイルが削除された場合には、例外処理が必要ですか？
- VBSのGetFolderメソッドでフォルダ内のファイルが削除された場合、排他制御は行われるのでしょうか？
- VBSのGetFolderメソッドを使用してフォルダ内のファイルをチェックする際、削除されたファイルに対してどのように対応すればよいのか教えてください。
- ベストアンサー
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 皆様のお知恵をお貸しください。
- novnovpooh
- お礼率100% (1/1)
- Visual Basic
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
排他制御は行われないようですよ GetExtentionNameメソッドが失敗するようです FileオブジェクトのOpenAsTextStreamや FSOのOpenTextFileでTextStreamを取得した場合は Streamを閉じるまでは削除が延期されるようです
関連するQ&A
- 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 調べているのですが、簡単なソースしか作れません。 お願いします
- ベストアンサー
- その他（プログラミング・開発）
- ＶＢＳ ファイルマージ処理
特定のDir内、複数ファイルのレコードを全てマージする為、 以下の処理を考えておりますが実現に至っておりません。 Fileがなくなるまで、ループ処理をさせる為、File名 の(1)から(2)へFile名の受け渡し方法が解かりません。 何方か有識者の方、ご教授頂けませんでしょうか もっと賢くマージが出来るので有りますならば、その方法 を教えて頂けませんでしょうか ※Dir内にFileはユニークなFile名にて、複数個作られます。 ※マージに必要なFileだけがDirには作られます。 ※マージするFileの順番は問いません。 (1)C:\temp\temp Dir内のFile名を取得 Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\temp\temp") objFile = objFso.GetAbsolutepathname("temp_ini.txt") Set objOut = objFso.OpenTextFile(objFile, 2, False) For Each objFile In objFolder.Files objFilemei = objFile.Name objOut.Writeline objFilemei next ※File名の受け渡しがわからず、一旦Fileに書き出してます (2)Fileが無くなるまで、File内のレコードを全て読込み、マージファイルを作成(予定) objFile1 = objFso.GetAbsolutepathname("temp_temp.txt") Set objin = objFso.OpenTextFile("temp_ini.txt",1) Do Until objin.atendofstream = True linedata = objin.readline() loop 説明が悪くてすみませんが、よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- FileSystemObject ＆ For Eachループで・・・
皆様こんにちは！ VBAでプログラムを作っていて不明点があり困っています。 FileSystemObjectを使用してあるフォルダにあるサブフォルダ内のすべての ファイルをコピーしフォルダを削除する処理を作成しています。 Set objFolder = objFs.GetFolder("C:\TEST") For Each objSubFolder In objFolder.subfolders 'TESTフォルダ内にあるサブフォルダ獲得 For Each objFile In objSubFolder.Files 'サブフォルダ内のファイル獲得 ON Error Go To CopyErr objFs.CopyFile(objFile.Path,"コピー先名") 'ファイルコピー処理 ON Error Go To 0 Set objFile = Nothing Next Set objSubFolder = Nothing Next Set objFolder = Nothing objFs.DeleteFolder("C:\TEST") 'TESTフォルダ削除 Set ObjFs = Nothing exit sub CopyErr: Set objFile = Nothing Set objSubFolder = Nothing Set objFolder = Nothing objFs.DeleteFolder("C:\TEST") Set ObjFs = Nothing end sub 上の様な処理でファイルのコピーでエラーが発生し CopyErrへ飛んだ場合、TESTフォルダの削除時に ”書込みできません”とエラーが発生し TESTフォルダが削除できません(その中のサブフォルダは削除されます)。 正常にFor Each文を抜けた場合は問題なく削除するので解せません。 For EachからはGo To,Exit等で抜けるとまずいのでしょうか？ 上の様な処理を作成しようと思えば、Dirを使用した方がいいのでしょうか？ (Nothingの処理は元々なかったのですが、 この現象が出たため試しにつけてみたものです。) どなたかアドバイスをお願い致します。
- ベストアンサー
- 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
- セレクトボックスに表示されたファイル名を変数に格納する方法
すみません、説明が足りませんでした。 あるフォルダに存在するファイルをセレクトボックスに １行毎に１ファイル名表示させています。 そのファイル名の中から１つのファイル名を選択し、 実行ボタンを押したタイミングで、選択されたファイル名を Dimで定義した変数に格納したいのです。 私の記述では<option>タグは１つのみで複数のファイル名を 表示させています。 ///////////////////////////////////////////////////////// 現在以下のソースを記述しています。 <% Set objFS = CreateObject("Scripting.FileSystemObject") Set objFolder = objFS.GetFolder("C:\TEMP") For Each objFile In objFolder.Files str = str & objFile.Name & vbCR next %> <SELECT SIZE=20 ID=select1 NAME=select1 STYLE="width:320px" MULTIPLE TABINDEX=70> <% For Each objFile In objFolder.Files %> <option><%= objFile.Name%></option> <% Next %> </SELECT>
- ベストアンサー
- HTML
- 特定のワークシートcsvファイル書き出しほか
エクセルブックの中身が、 1番目 graphシート 2番目から19番目 ワークシート で構成されているエクセルファイルが100個 AAAというフォルダに入っています。 それぞれのエクセルブックにあるシートを、ブックのファイル名にしたフォルダを作成し、その中にcsvで書き出すプログラムを作りました。 また、AAAのフォルダの１つ上のフォルダ（VBA実行するカレントフォルダ）には、テキストファイルもあり、作成されたフォルダに合わせてコピーするようにしています。 一応、期待通りの動作をしましたが、スッキリとしたプログラムとするために、アドバイスをいただけないでしょうか？ また、できれば、それぞれのブックの2番目から7番目のワークシートのみをcsvファイルで書き出したいと思い、シートを2番目から順にアクティブにして書き出すように変更しても1番目のグラフシートからcsvになってしまいました。 特定のワークシートのみをcsvファイルで書き出すにはどのように書いたら良いでしょうか？ よろしくおねがいしむす Sub ファイル一括作成() Application.ScreenUpdating = False '対象ブックの選択 'フォルダ内のブックを順次選択 Dim FolderPath As String Dim objFSO As Object Dim objBook As Object Dim objFiles As Object Dim objFile As Object Dim mysma4 As Object Set objFSO = CreateObject("Scripting.FileSystemObject") FolderPath = ActiveWorkbook.Path & "\AAA" Set objBook = objFSO.GetFolder(FolderPath) Set objFiles = objFSO.GetFolder(FolderPath).Files Set mysma4 = objFSO.GetFile(ActiveWorkbook.Path & "\fig_all.TXT") For Each objFile In objFiles If objFSO.GetExtensionName(Path:=objFile) Like "xlsx" Then 'ベースファイル名フォルダ作成&sma4ファイルコピー objFSO.CreateFolder Path:=FolderPath & "\" & objFSO.GetBaseName(objFile) mysma4.Copy Destination:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\fig_all.TXT" '各ファイルcsv書き出し Workbooks.Open objFile.Path For Each ws In Worksheets '各シートに対して処理を繰り返す ws.Activate 'ベースファイルと同じ階層に出力 ActiveWorkbook.SaveAs _ Filename:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\" & ws.Name & ".csv", _ FileFormat:=xlCSV Next ws ActiveWorkbook.Close SaveChanges:=False Else End If Next MsgBox "ファイル作成が完了しました。" Set objFSO = Nothing Set objBook = Nothing Set objFiles = Nothing Set mysma4 = Nothing Application.ScreenUpdating = True End Sub
- ベストアンサー
- Excel（エクセル）
- VBS
VBSであるファイルを１行ずつ読み込み、その読み込んだ値を ある別のファイルにリダイレクトしたいのですが、 どのように書けばよいか教えてください。 下記のように、echoでは出すことができるのですが、 ファイルにリダイレクトというのができません。 よろしくお願いします。 ==== sample shell ========================= Option Explicit On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile("d:\dr1.txt") If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True WScript.Echo objFile.ReadLine Loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing ============================================================
- 締切済み
- その他（プログラミング・開発）
- 選択したファイル名を取得する方法について -再度質問します-
ASPとVBScript、JavaScriptを使用した開発を行っています。 あるフォルダに存在するファイルをセレクトボックスに １行毎に１ファイル名表示させています。 そのファイル名の中から１つのファイル名を選択し、 実行ボタンを押したタイミングで、選択されたファイル名を Dimで定義した変数に格納したいのです。 当方ASPでの開発は初心者でして、クライアント側、サーバ側の 処理の区別がまだつかない状況で申し訳ないのですが FORMタグなどを使用しているので、サーバ側処理になると思うのですが 教えて頂けると有り難いです。 私の記述では<option>タグは１つのみで複数のファイル名を 表示させています。 ///////////////////////////////////////////////////////// 現在以下のソースを記述しています。 <% Set objFS = CreateObject("Scripting.FileSystemObject") Set objFolder = objFS.GetFolder("C:\TEMP") For Each objFile In objFolder.Files str = str & objFile.Name & vbCR next %> <SELECT SIZE=20 ID=select1 NAME=select1 STYLE="width:320px" MULTIPLE TABINDEX=70> <% For Each objFile In objFolder.Files %> <option><%= objFile.Name%></option> <% Next %> </SELECT>
- ベストアンサー
- HTML
- vbsで最後の行を削除する
csvファイル(test.csv)からフラグが１のものを抽出するのですが 最終行に改行がはってしまうので、最終行を削除してcsvファイルを保存したいのですが、 うまくいきません。ご教授ください。 Dim objADO Dim i Dim wsql Dim rs Dim wHeader Dim wData Dim objFSO Dim objFile Set objADO = CreateObject('ADODb.connection') objADO.Open "Driver={Microsoft Text Driver (*.txt;*csv)};"&_ "DBQ=C:\test;"&_ "ReadOnly=1" '抽出条件 wsql="select * from test.csv where フラグ='1'" Set rs =objADO.Execute(Wsql) 'ヘッダ部 wHeader='ID,商品名,商品番号,フラグ" 'データ部 wData="" Do While rs.EOF=False For i = 0 to rs.fields.count - 1 if i = (rs.fields.count -1) then wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & chr(13) else wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & "," end if next rs.MoveNext loop '最終改行削除？ rs = Left(wData,Len(wData) - Len(chr(13))) 'ファイル出力 set objFSO = createObject("Scripting.FileSystemObject") set objFile = objFSO.OpentextFile("c:\test\test.csv",2, true) if err.Number = 0 then objFile.WriteLine(wHeader) objFile.WriteLine(wData) objFile.close end if set objFile = Nothing set objFSO = Nothing set objADO = Nothing ****************************************** ID,商品名,商品番号,フラグ 100,パソコン,100-12,1 200,ペン,200-11,1 ***ここの改行を削除する***** 〔EOF〕
- ベストアンサー
- その他（プログラミング・開発）
- VBS 1行ずつファイルを読み込める/読み込めない
いつもお世話になっております。 http://okwave.jp/qa/q8672643.html 前回質問させていただいた、 ｔｘｔファイルをHTMLに自動的に変換するプログラムを 作成中ですが、 ひとつ分からない点があるため、質問させていただきました。 ためしに、テキストファイル２つ。 VBSファイル１つをフォルダに置いて実行してみました。 しっかり1行ずつ実行できているか Msgbox を使って確認したのですが、 1つ目のファイル「読み込み失敗.txt」が1度で全部読み込みしてしまい、 2つ目のファイル「読み込み成功.txt」は1行ずつ読み込め、無事変換できております。 ------------読み込み失敗.txt------------- Private Sub CommandButton1_Click() Application.DisplayAlerts = False Application.ScreenUpdating = False ''資料作成 ChertGraph.ComboBox1.Value = Me.ComboBox1.Value 'データ入力 Call ChertGraph.CommandButton1_Click 'ボタンクリック Graph_MAKE.ComboBox1.Value = Me.ComboBox1.Value'データ入力 Graph_MAKE.ComboBox1.Value = Me.ComboBox1.Value'データ入力 Call SCKindofGraph_SELECT.BothCreate_Click'ボタンクリック Call SCKindofGraph.CommandButton1_Click 'ボタンクリック History.ComboBox3.Value = Me.ComboBox1.Value '履歴に値を入れる Call History.CommandButton1_Click '履歴出力実行 Call BookCopy 'データ出力 Application.DisplayAlerts = True Application.ScreenUpdating = True Call Module1.sheet_sort MsgBox Me.ComboBox1.Value & vbCrLf & "完了しました。" Worksheets("TOP").Activate End End Sub ---------------------------------------- ------------読み込み成功.txt------------- Sub ComboboxNarabi() Dim i As Long Dim j As Long Dim Count As Long Dim Swap As String Dim SortListData As Variant SortListData = Array("A", "B", "C", "D", "E", "F", "G", "") Count = 0 For j = 0 To UBound(SortListData) For i = 0 To ComboBox2.ListCount - 1 If ComboBox2.List(i) = SortListData(j) Then Swap = ComboBox2.List(Count) '現在の位置の内容をSwapにコピー ComboBox2.List(Count) = ComboBox2.List(i) '現在位置に、検索したワードをコピー ComboBox2.List(i) = Swap 'もとの内容をコピー Count = Count + 1 End If Next Next End Sub ---------------------------------------- --------------VBSファイル--------------- Dim strScriptPath'自分の現在位置 strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")'フルネームから、スクリプトネームを削除！ ' フォルダをオブジェクト取得 Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFso.GetFolder(strScriptPath) for each file in objFolder.Files If file.name<> WScript.ScriptName and Right(file.name,5)= ".html" Then objFso.DeleteFile file.Path End if Next Set objFolder = objFso.GetFolder(strScriptPath) for each file in objFolder.Files If file.name<> WScript.ScriptName and Right(file.name,4)= ".txt" Then Msgbox file.Path Set HTMLOutPutData = objFso.CreateTextFile(objFso.GetBaseName(file) & ".html",True) Set fileRead = objFSO.OpenTextFile(file)'ファイルを開く If Err.Number = 0 Then HTMLOutPutData.WriteLine "<html>" HTMLOutPutData.WriteLine "<head>" HTMLOutPutData.WriteLine "<title></title>" HTMLOutPutData.WriteLine "</head>" HTMLOutPutData.WriteLine "<body>" HTMLOutPutData.WriteLine "<h1 align=""" &"center" &""">"& objFso.GetBaseName(file) & "</h1>" HTMLOutPutData.WriteLine "<hr>" Do Until fileRead.AtEndOfStream = true LINEDATA = fileRead.ReadLine Msgbox LINEDATA If InStr(LINEDATA,"'") = 0 then'含んでない場合 HTMLOutPutData.WriteLine "<font color=""" &"black"&""">" & LINEDATA & "</font><br>" Else HTMLOutPutData.WriteLine Replace(LINEDATA,"'","<font color=""" &"green"&""">'") & "</font><br>" End if Loop HTMLOutPutData.WriteLine "</body>" HTMLOutPutData.WriteLine "</html>" fileRead.Close Else MsgBox "ファイルが開けません" End If End if Next Msgbox "終わり！" ---------------------------------------- LINEDATA = fileRead.ReadLine Msgbox LINEDATA と実行した場合に、何故1行ずつ読み込めていないのか 調べ方が悪いのか情報が無かったため 何か情報があれば、お願い致します！ 以上、よろしくお願い致します。
- ベストアンサー
- Visual Basic
お礼
redfox63 様、早速の回答助かりました。 実は、削除処理自体が排他制御される事を恐れていましたので、 ど真ん中の回答でした。 当方でも、For Eachでブレイクして削除を試してみた結果、 問題無く削除されました。 ありがとうございました。