VBSファイルを1行ずつ読み込めるかどうかの確認方法

このQ&Aのポイント
  • VBSファイルを1行ずつ読み込む方法について、試行した結果、ファイルの一部が全て読み込まれてしまう現象が発生しました。
  • 読み込み失敗.txtのファイルでは、私たちはPrivate Sub CommandButton1_Click()という関数を使用しています。この関数は、複数の処理を実行するために使用されています。
  • VBSファイルの読み込みに関する情報や解決策が不明なため、追加の情報を求めるために質問を投稿しました。
回答を見る
  • ベストアンサー

VBS 1行ずつファイルを読み込める/読み込めない

いつもお世話になっております。 http://okwave.jp/qa/q8672643.html 前回質問させていただいた、 txtファイルをHTMLに自動的に変換するプログラムを 作成中ですが、 ひとつ分からない点があるため、質問させていただきました。 ためしに、テキストファイル2つ。 VBSファイル1つをフォルダに置いて実行してみました。 しっかり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行ずつ読み込めていないのか 調べ方が悪いのか情報が無かったため 何か情報があれば、お願い致します! 以上、よろしくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
  • chie65535
  • ベストアンサー率43% (8481/19299)
回答No.1

失敗している方のテキストファイルの改行コードが、Windows形式の改行コードになっているか確認しましょう。 OSの違いによる改行コードの違いについて http://www.rsch.tuis.ac.jp/~mizutani/online/with-pc/textline.html 他の形式(LFのみ、CRのみ)の場合、VBAのReadLineは「CR+LFが現れるまでを1行として扱う」ので、1度で全部を読み込んでしまいます。 Visual Basic Editorなどで見ていると違いに気付けませんが、Windowsのメモ帳で見ると、CR+LF以外の改行では改行されずに表示されるので、メモ帳で開いて確認してみましょう。

satoron666
質問者

お礼

回答ありがとうございました。 メモ帳で確認してみたところ、仰るとおりでした。 一旦Terapadで開き、メモ帳に貼り付けて保存しなおすことで 直りました! ありがとうございました^^

satoron666
質問者

補足

'スクリプト名を含まないフルパスを編集する(自分の場所のみ表示) 'strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"") 'スクリプト名を含むフルパス 'WScript.echo "スクリプト名を含む " & WScript.ScriptFullName 'スクリプト名を含まないフルパス 'WScript.echo "スクリプト名を含まない " & strScriptPath 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 objFso.GetBaseName(file)ファイル名 Set HTMLOutPutData = objFso.CreateTextFile(objFso.GetBaseName(file) & ".html",True) Set fileRead = objFSO.OpenTextFile(file)'ファイルを開く '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.AtEndOfStream = true LINEDATA = fileRead.ReadLine If InStr(LINEDATA,"'") = 0 then'含んでない場合 HTMLOutPutData.WriteLine "<font color=""" &"black"&""">" & LINEDATA & "</font><br>" Else HTMLOutPutData.WriteLine "<font color=""" &"black"&""">" & Replace(LINEDATA,"'","</font><font color=""" &"green"&"""><b>'") & "</b></b></font><br>" End if Loop HTMLOutPutData.WriteLine "</body>" HTMLOutPutData.WriteLine "</html>" fileRead.Close Else MsgBox "ファイルが開けません" End If End if Next Msgbox "終わり!" というプログラムにしてみました。(変わっていないかも…?)

関連するQ&A

  • 【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くらいのサイズになります。(他のファイルは2K程度です) それを削除しようとすると、どんどんパソコンが重くなり… どこかのループが悪さしているのでしょうか?

  • 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 皆様のお知恵をお貸しください。

  • 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>

  • ファイルを探すプログラムで c:\のみ動かない

    ファイルを探すプログラムをネット頂き テストしたのですが c:\ のみ 動かず c:\*** は そのフォルダーから下を探します e:\ は 全てのフォルダーを探します。 WIN8 ですが どこで間違ってるのでしょうか? よろしくどうぞ 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

  • VBS ファイルマージ処理

    特定の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で、凝ったHTMLを出力する!

    いつも大変お世話になっております。 上手く説明できない点もあるかと思いますが、 よろしくお願い致します。 現在、色々とプログラムを組むことが多く、 毎回調べては書いて…の繰り返しのため 良く使うもの・便利だったものはメモ帳などに貼り付けて 保存してあります。 しかし、この状態では メモ帳が大量にあり探すのにとても苦労しますし、 内容もとても見づらいものになってしまいます。 現在、同フォルダにあるTXTファイルを自動的にHTMLに変換するVBSと 同フォルダにあるファイルのリンクを作成し、一覧をHTMLにするVBSを作りました。 少しずつ便利にはなってきていますが、 やはり見づらさという点では変わりありません。 そこで、やりたいこととしまして ・ジャンル別に分けたい。 (できればツリー状にして表示したい) ・2フレームで作成したい。(左側に目次、選択したものを右側に表示) 全自動でHTMLファイルを作成しようと思っているのですが、 さすがにむずかしいでしょうか? 例えば HTML化用ファイル   |   |--「HTMLファイルをここに作成」   |   --TEST     |      ------ブック     |    |___新規ブック.html     |    |     |    |___ブック名編集.html     |      ------シート     |    |___新規シート.html     |    |     |    |___シート編集.html     |    |     |    |___シート保護.html     |    |     |    |___シートコピー.html     |    |     |    |___シート削除.html     |         |         |          ------目次3     |      ------目次4     |      ------目次5 ----------------------------------------- 【理想】           |    TEST    |      |     |       ------ブック   |     |    |___新規ブック.html | クリックしたHTMLの内容表示     |    |    |     |    |___ブック名編集.html |     |     |      ------シート   |     |    |___新規シート.html |     |    |    |     |    |___シート編集.html |     |    |    |     |    |___シート保護.html |     |    |    |     |    |___シートコピー.html |     |    |    |     |    |___シート削除.html  |     |        |     |        |     |        |      ------目次3  |     |     |      ------目次4  |     |     |      ------目次5  | ↑↑ 折りたたむことも可能↑↑ 今は、同じフォルダ内にあるものを 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として出力する方法があれば、 教えて下さい。 よろしくお願い致します。 以上、よろしくお願い致します。

  • vbsで最後の行を削除する

    csvファイル(test.csv)からフラグが1のものを抽出するのですが 最終行に改行がはってしまうので、最終行を削除して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でファイル作成後、書き込みできない

    ファイルが存在している場合は、ファイルをオープンして書き込み、ファイルが存在していない場合は、ファイルを作成後、オープンして書き込みを行わせたいと考えています。 しかし、ファイルが存在していないとき、ファイルは作成されるのですが、『エラー: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"

  • VBS

    VBSであるファイルを1行ずつ読み込み、その読み込んだ値を ある別のファイルにリダイレクトしたいのですが、 どのように書けばよいか教えてください。 下記のように、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 ============================================================

  • 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