【VBS】テキスト→HTML自動作成 - プログラムのエラーと重さの原因は？
- 同じフォルダの中にあるtxtファイルを自動的にHTML化するプログラムを作成していますが、エラーが発生し続けます。
- プログラムを実行すると、1つ目のファイルが他のファイルと比べて重くなり、サイズが300K近くになります。また、ファイルを削除しようとすると、パソコンが重くなることもあります。
- 原因はどこかのループにある可能性がありますが、具体的な原因を特定することができません。プログラムの改善方法について教えてください。
- ベストアンサー
【VBS】 テキスト→HTML 自動作成
お世話になっております。 同じフォルダの中に入っているtxt全てを 自動的にHTML化しようと思っています。 分からないなりに考えて書いたのは下記コードです。 --------------------------------- Dim strScriptPath'自分の現在位置 strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")'フルネームから、スクリプトネームを削除！ ' フォルダをオブジェクト取得 Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFso.GetFolder(strScriptPath) for each file in objFolder.Files Set fileRead = objFSO.OpenTextFile(file)'ファイルを開く If file.name<> WScript.ScriptName Then 'Msgbox objFso.GetBaseName(file)ファイル名 Msgbox objFso.GetBaseName(file) Set HTMLOutPutData = objFso.CreateTextFile(objFso.GetBaseName(file) & ".html",True) 'If InStr(l, "本社") = 0 含んでない場合 'Replace(文字列,どれを、どれに) '<font color="green">文字列</font>緑色に 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.AtEndOfLine = true LINEDATA = fileRead.ReadLine 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 "終わり！" ------------------------------------------- とりあえず、'の後全ては緑色に変更。 1行読み込み、1行ずつ改行。 元のファイル名と同じで、拡張子を.htmlにして保存。 これを目標にやっていましたが、 全ファイル思ったとおりに行くわけではなく エラーの連続です。 プログラムが悪いのでしょうか？ 1個目のファイルはどんどん重くなり、 300Kくらいのサイズになります。（他のファイルは２K程度です） それを削除しようとすると、どんどんパソコンが重くなり… どこかのループが悪さしているのでしょうか？
- satoron666
- お礼率86% (306/354)
- Visual Basic
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
「いつ，どんなときにそうなる(ファイルはどんどん重くなる)のか？」 この条件を探すのに少々手間取りましたが， その VBS ファイルが存在するフォルダ内に 元から HTML ファイル(実際は拡張子 .html のファイル)が存在したときに そうなるようですよ。 当たり前と言えば当たり前ですが， VBS ファイルが存在するフォルダ内に 最初から拡張子 .html のファイルがあった場合， 「そのHTMLファイルを開いてはタグを付け加えて同じ名前で保存する。」 この作業を延々と繰り返すわけですから 巨大ファイルができてしまいます。 (できるというよりも，作ろうとして強制終了させない限り PC が重くなる。) 結局，制限のかけ方が間違っているのだと思います。 現時点では If file.name <> WScript.ScriptName Then という制限を付けて VBS ファイル(つまり自分自身)以外のであれば どんなファイルにでもタグを付けて行って HTML として保存させようとしています。 そうではなくて 同じ部分を If Right(file.name,4) = ".txt" Then のように変更して 拡張子 .txt のファイルに対してのみ プログラムを実行させるとか， せめて If file.name <> WScript.ScriptName And Right(file.name,5) <> ".html" Then のように変更して 自分自身以外と，拡張子 .html 以外のファイルに対して プログラムを実行させるとかに変更する必要があると思います。 そうしないと メモリ や CPU どころか ドライブの全容量食いつくし現象が起きて ハード自体も危ないことになるかもしれませんよ。
その他の回答 (1)
- mitarashi
- ベストアンサー率59% (574/965)
回答ではありません。そもそもVBSじゃありませんし。話の種程度にご覧下さい。 今時<FONT>タグなんて使っていいのか（HTML5では廃止される）とか、HTMLエスケープしないで大丈夫とか思って試している内に、昔VBAコードのコメント行に色をつけたHTMLコードを生成してくれるアドインがあったのを思い出して、自分で作ってみてやろうと思ったのが泥沼にはまるきっかけでした．．． ・FileSystemObjectのOpenTextFileだと、エクスポートしたVBAコードのファイル読み込みを途中で打ち切ってしまう。 ・CreateTextNodeのHTMLエスケープ機能が不十分（&と<>しかエスケープしない。やるなら徹底してやってくれよ．．．） ・IE9で動いたコードがIE8では動かない（Style sheetを動的に生成する際のIE8のバグ？方言？らしい） おまけに同じWindows7Home(64bit)で動いていたRegExの置換のコードが、家のDesktopPCではOKで、NotePCだと実行時エラー と、盛りだくさんでした。 なお、VBAコードのエクスポートをVBAで制御するには、xl2003以降のバージョンは、[Visual Basic プロジェクトへのアクセスを信頼する] チェック ボックスをオンにする必要があります。在処はバージョンにより異なります。 Win7Home(64bit)、xl2010(32bit)、IE8で動いたコードです。 Sub displayCode() Dim objIE As Object, doc As Object Dim myheader As Object, mybody As Object Dim cssElement As Object, pElement As Object, emElement As Object Dim objFSO As Object, fileRead As Object, fileWrite As Object Dim lineData As String, buf As String Dim outputFilePath As String Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'お約束 objIE.navigate "about:blank" Set doc = objIE.document 'WebPageの基本形を与える doc.Write "<html><head></head><body></body></html>" Set myheader = doc.getElementsByTagName("head")(0) Set mybody = doc.getElementsByTagName("body")(0) 'CSSの設定 'emはデフォルトで斜体になる様です。 Set cssElement = doc.createElement("style") cssElement.Type = "text/css" 'IE8 cssElement.styleSheet.cssText = "em.comment{color:green;}" 'IE9 'cssElement.innerText = "em.comment{color:green;}" myheader.appendchild cssElement 'htmlエスケープが必要と思ったが、createTextNodeの中途半端な仕様の所為で思わぬ苦労をした 'createTextNodeは「&<>」のみescape 'これはTextNodeのオブジェクトを操作しても同様 'なお、s/w-quatationはIEのDOMで内部的に自動で変換している様に思える Set pElement = doc.createElement("p") Set objFSO = CreateObject("Scripting.FileSystemObject") 'なぜかobjFSO.OpenTextFileだと2行位読み込んで打ち切ってしまう Set fileRead = objFSO.GetFile(GetDesktopPath & "\Module1.bas").OpenAsTextStream outputFilePath = GetDesktopPath & "\Module1.html" Do Until fileRead.AtEndOfStream lineData = fileRead.ReadLine If Left(Trim(lineData), 1) <> "'" Then buf = Replace(lineData, vbTab, " ") pElement.appendchild (doc.createTextnode(buf)) pElement.appendchild (doc.createElement("br")) 'コメントの時 Else Set emElement = doc.createElement("em") emElement.className = "comment" buf = Replace(lineData, vbTab, " ") emElement.appendchild (doc.createTextnode(buf)) pElement.appendchild emElement pElement.appendchild (doc.createElement("br")) End If Loop fileRead.Close pElement.innerHTML = htmlEscape(pElement.innerHTML) 'bodyにpタグとして書き出す mybody.appendchild pElement Set fileWrite = objFSO.CreateTextFile( _ Filename:=outputFilePath, Overwrite:=True) fileWrite.Write doc.getElementsByTagName("html")(0).outerHTML fileWrite.Close Set objFSO = Nothing End Sub Function htmlEscape(srcString As String) As String Dim regEx As Variant, Matches As Variant, match As Variant Dim buf As String buf = srcString Set regEx = CreateObject("VBScript.RegExp") regEx.MultiLine = True '> <で囲まれた部分のみ抽出して、その中のスペースを置換した文字列で更に置換する regEx.Pattern = ">.*?<" regEx.IgnoreCase = True regEx.Global = True Set Matches = regEx.Execute(buf) For Each match In Matches buf = Replace(buf, CStr(match), Replace(CStr(match), " ", " ")) Next match Set Matches = Nothing Set regEx = Nothing htmlEscape = buf End Function 実装してないですがModuleのエクスポート 'http://okwave.jp/qa/q5167092.html Sub CodeExport() Dim A, B Set A = ThisWorkbook.VBProject.VBComponents For Each B In A If B.Type = 1 Then B.Export GetDesktopPath & "\" & B.Name & ".bas" Next End Sub Private Function GetDesktopPath() As String Dim wScriptHost As Object, strInitDir As String Set wScriptHost = CreateObject("Wscript.Shell") GetDesktopPath = wScriptHost.SpecialFolders("Desktop") Set wScriptHost = Nothing End Function
お礼
回答ありがとうございます。 VBAとVBS、プログラムの流れ？は同じですものね！ 参考になります＾＾ 試してみます！ ありがとうございました！
補足
色々考えた結果、 .htmlがあった場合は削除する方法にしました。 無事、上手く動き始めた…気はしますが まだまだ問題は山積みみたいです＾＾； ありがとうございました＾＾
関連するQ&A
- 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
- VBSで、凝ったHTMLを出力する！
いつも大変お世話になっております。 上手く説明できない点もあるかと思いますが、 よろしくお願い致します。 現在、色々とプログラムを組むことが多く、 毎回調べては書いて…の繰り返しのため 良く使うもの・便利だったものはメモ帳などに貼り付けて 保存してあります。 しかし、この状態では メモ帳が大量にあり探すのにとても苦労しますし、 内容もとても見づらいものになってしまいます。 現在、同フォルダにあるTXTファイルを自動的にHTMLに変換するVBSと 同フォルダにあるファイルのリンクを作成し、一覧をHTMLにするVBSを作りました。 少しずつ便利にはなってきていますが、 やはり見づらさという点では変わりありません。 そこで、やりたいこととしまして ・ジャンル別に分けたい。 （できればツリー状にして表示したい） ・2フレームで作成したい。（左側に目次、選択したものを右側に表示） 全自動でHTMLファイルを作成しようと思っているのですが、 さすがにむずかしいでしょうか？ 例えば HTML化用ファイル | |--「HTMLファイルをここに作成」 | --TEST ｜ ------ブック ｜ |___新規ブック.html ｜ | ｜ |___ブック名編集.html ｜ ------シート ｜ |___新規シート.html ｜ | ｜ |___シート編集.html ｜ | ｜ |___シート保護.html ｜ | ｜ |___シートコピー.html ｜ | ｜ |___シート削除.html ｜ ｜ ｜ ------目次３ ｜ ------目次４ ｜ ------目次５ ----------------------------------------- 【理想】 | TEST | ｜ | ------ブック | ｜ |___新規ブック.html | クリックしたHTMLの内容表示 ｜ | | ｜ |___ブック名編集.html | ｜ | ------シート | ｜ |___新規シート.html | ｜ | | ｜ |___シート編集.html | ｜ | | ｜ |___シート保護.html | ｜ | | ｜ |___シートコピー.html | ｜ | | ｜ |___シート削除.html | ｜ | ｜ | ｜ | ------目次３ | ｜ | ------目次４ | ｜ | ------目次５ | ↑↑ 折りたたむことも可能↑↑ 今は、同じフォルダ内にあるものを HTML化することはできています。 ------------------- Sub TEST2() Dim strScriptPath'自分の現在位置 strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")'フルネームから、スクリプトネームを削除！ ' フォルダをオブジェクト取得 Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFso.GetFolder(strScriptPath) Set HTMLOutPutData = objFso.CreateTextFile("ファイル一覧.html",True) HTMLOutPutData.WriteLine "<html>" HTMLOutPutData.WriteLine "<head>" HTMLOutPutData.WriteLine "<title></title>" HTMLOutPutData.WriteLine "</head>" HTMLOutPutData.WriteLine "<body>" HTMLOutPutData.WriteLine "<h1 align=""" &"center" &""">まとめ</h1>" HTMLOutPutData.WriteLine "<hr>" for each file in objFolder.Files If file.name<> "ファイル一覧.html" and file.name<> WScript.ScriptName and Right(file.name,4)<> ".vbs" Then HTMLOutPutData.WriteLine "<font size=""" &"5" &"""><a href=""" & file.Path & """>"& file.name & "</a></font><br>" End if Next HTMLOutPutData.WriteLine "</body>" HTMLOutPutData.WriteLine "</html>" End Sub ------------------ http://lll.s21.xrea.com/m/link/37.html Javascriptは特にやっていなかったのと、 HTMLも不慣れなため、簡単なものしかかけませんでした。 フォルダ内の状況をそのまま HTMLとして出力する方法があれば、 教えて下さい。 よろしくお願い致します。 以上、よろしくお願い致します。
- ベストアンサー
- Visual Basic
- VBSでファイル作成後、書き込みできない
ファイルが存在している場合は、ファイルをオープンして書き込み、ファイルが存在していない場合は、ファイルを作成後、オープンして書き込みを行わせたいと考えています。 しかし、ファイルが存在していないとき、ファイルは作成されるのですが、『エラー：800A0046 書き込みできません。VBScript実行時エラー』が出て、書き込みができません。モードをWritingにしても同じでした。 お手数をおかけしますが、ご教示いただけますようお願いいたします。 Option Explicit '■ オブジェクトの宣言 Dim objFSO Dim objFile '■ 定数の宣言 Const strFileName = "C:\VBS\TEST.TXT" '■ 定数の宣言 '// ファイル入出力モード(8:追加書き込み) Const ForAppending = 8 Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else WScript.Echo "ファイルが見つかりませんでした" Set objFile = objFSO.CreateTextFile(strFileName) If IsObject(objFile) Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If '// ファイルのオープン Set objFile = objFSO.OpenTextFile(strFileName,ForAppending) objFile.WriteLine "2012/12/21,100,ブレーキパッド,35000"
- ベストアンサー
- Visual Basic
- 【VBScript】プログラム改良
VBScriptのプログラムについて、 回答頂きたく投稿しました。 以下を実行すると、 65行目で「'End'がありません。」とエラー表示されてしまいます。 End Ifは入れているはずですが、どこが問題なのでしょうか？ またIfステートメントを少し減らしたいのですが、 どうすればシンプルな形になりますでしょうか？ 恐れ入りますが、アドバイス頂ければ幸いです。 Option Explicit Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS intCount = 0 If WScript.Arguments.Count = 0 Then WScript.Echo "引数が指定されていません。" WScript.Quit End If For Each strArg In WScript.Arguments intCount = intCount + 1 strFile = strArg Next Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.GetExtensionName(strFile) <> "txt" Then If intCount > 1 Then MsgBox "2つ以上のファイルが指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" WScript.Quit Else MsgBox "テキストファイル以外が指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" WScript.Quit End If Else strX = InputBox("抽出したい文字列を入力してください。", "変換処理") If strX <> "" Then lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr _ & "変換しますか？", 4 + 32 + 0, "確認") If lonmsgbox = 6 Then strNewFile = objFSO.BuildPath( _ objFSO.GetParentFolderName(strFile), _ objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) Set objOpen = objFSO.OpenTextFile(strFile, 1) Do Until objOpen.AtEndOfStream = True strText = objOpen.ReadLine If InStr(strText, strX) > 0 Then objTS.WriteLine strText End If Loop objTS.Close Set objTS = Nothing objOpen.Close Set objFSO = Nothing WScript.Sleep 1000 MsgBox ("文字列の抽出が完了しました。") Else MsgBox ("処理を中断します。") End If End If ElseIf IsEmpty(strX) then MsgBox ("キャンセルされました。") WScript.Quit Else MsgBox "文字列が入力されていません。" & vbCr _ & "入力し直してください。", 0, "Error" WScript.Quit End If
- 締切済み
- その他（プログラミング・開発）
- VBSでフォルダ、ファイル作成時のエラーコード
フォルダ、ファイルが存在しないとき、作成するスクリプトをVBSで作成していますが、疑問点があるのでご教示ください。 objFSO.CreateFolder、objFSO.CreateTextFileを実行が、正常に行われた場合、 Err.Numberに0がセットされると思っていましたが、実際は違っていました。 objFSO.CreateFolderでフォルダが作成される場合、Err.Numberに13が返されます。 objFSO.CreateTextFileでファイルが作成される場合、Err.Numberに438が返されます。 このスクリプトを実行後、フォルダ、ファイルが存在しない場合、作成されることも確認しています。 フォルダ作成後、作成されたフォルダに対して、ファイルの作成／データの書き込みのアクセス権を拒否にすると返されるErr.numberに70がセットされることも確認しています。 なぜ、フォルダ、ファイルが作成された場合、0が返されないのかご存知の方がいらっしゃいましたらご教示ください。 また、その情報が記載されている書籍およびサイトがあれば、お教えいただければ、幸いです。 Option Explicit Dim objFSO Dim objFile Const strFolderName = "C:\VBS" Const strFileName = "C:\VBS\test.txt" On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then WScript.Echo "FSOオブジェクトを作成しました" Else WScript.Echo "FSOオブジェクトを作成できませんでした" WScript.Quit(1) End If If objFSO.FolderExists(strFolderName) Then WScript.Echo "フォルダが見つかりました" Else WScript.Echo "フォルダが見つかりませんでした" If objFSO.CreateFolder(strFolderName) Then If Err.Number = 13 Then WScript.Echo "フォルダを作成しました" Else WScript.Echo "フォルダを作成できませんでした" WScript.Quit(1) End If End If End If If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else Script.Echo "ファイルが見つかりませんでした" If objFSO.CreateTextFile(strFileName) Then If Err.number = 438 Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If End If
- ベストアンサー
- 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
- 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 ============================================================
- 締切済み
- その他（プログラミング・開発）
- ＶＢＳ ファイルマージ処理
特定の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 説明が悪くてすみませんが、よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- エクセルブックの複製(.vbs)
「原紙」という名前のエクセルブックがあり、新しいお客様が増えたらそのブックを複製し、更にその時にダイアログを出してお客様の名前を入力し、それをファイル名にしたいです。 下記の.vbsファイルに元ファイルをドラッグすると連番を付けて複数作る、という目的でのコマンドを見つけました（これも凄いですが）。 もし改良出来る方がいたら教えてください。 ・コピー数の指定は必要ありません（毎回1ファイルのみ複製）。 ・ドラッグすると、ダイアログが出てきて入力したものがファイル名になる。 よろしくお願い致します。 If WScript.Arguments.Count = 0 Then WScript.Quit Dim fso Set fso = CreateObject( "Scripting.FileSystemObject" ) '--- コピー元ファイルの確認 filePath = WScript.Arguments.Item(0) If fso.FileExists( filePath ) = False Then WScript.Echo filePath & "がありません" WScript.Quit End If '--- コピー数の指定 Num = InputBox( filePath & vbNewLine & "をいくつコピーしますか") If IsNumeric( Num ) = False Then WScript.Echo "数値を入力してください。" WScript.Quit End If If Num > 999 Or Num < 1 Then WScript.Echo "数値は１～999で指定してください。" WScript.Quit End If Extention = "." & fso.GetExtensionName( filePath ) '--- ファイルチェック For i=1 To Num newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention ) If fso.FileExists( newFilePath ) = True Then WScript.Echo "作成予定のファイル【" & newFilePath & "】が既に存在します。" WScript.Quit End If Next '--- ファイルコピー For i=1 To Num newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention ) fso.CopyFile filePath, newFilePath Next
- ベストアンサー
- Visual Basic
- 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
お礼
回答ありがとうございます。 >その VBS ファイルが存在するフォルダ内に >元から HTML ファイル(実際は拡張子 .html のファイル)が >存在したときにそうなるようですよ。 そうだったんですね！ 色々調べてくださりありがとうございます！ If file.name <> WScript.ScriptName And Right(file.name,5) <> ".html" Then この、拡張子がHTMLかどうか判別する方法を使わせて 頂きたいと思います。 ありがとうございました＾＾
補足
色々考えた結果、 .htmlがあった場合は削除する方法にしました。 無事、上手く動き始めた…気はしますが まだまだ問題は山積みみたいです＾＾； ありがとうございました＾＾