VBSでエラー原因を解決する方法について

このQ&Aのポイント
  • VBScriptでhtmlファイルの括弧( )を色付けしようとしています。
  • 自分なりにスクリプトを書いてみましたが、InStrの引数の型が違うと怒られ、進めなくなってしまいました。
  • また、もっといい方法があれば教えてください。
回答を見る
  • ベストアンサー

VBSでエラー原因が分かりません

VBScriptでhtmlファイルの括弧( )を色付けしようとしています。 vbsファイルにhtmlファイルをドラッグ&ドロップすると、括弧も含めて丸括弧内の文字色を変えるスクリプトを作ろうとしています。 対象となるhtmlファイルは、使っている丸括弧は、全て全角で必ず対になっています。本文以外のコメント等で丸括弧は使っていません。 括弧の色付けはタグを挿入するようにしていますが、括弧内の括弧では違う色にしたいと思っています。 自分なりにスクリプトを書いてみましたが、InStrの引数の型が違うと怒られ、進めなくなってしまいました。何が悪いか分からなくなってしまいました。 作成したコードの主要部分を載せます。 Option Explicit Dim m_objFso Dim continue '置換ループを抜ける変数 Set m_objFso = CreateObject("Scripting.FileSystemObject") '--------------------------------------------------------- Dim l_strItem For Each l_strItem In WScript.Arguments Call coloring( l_strItem ) Next Set m_objFso = Nothing '--------------------------------------------------------- Private Sub coloring( l_strItem ) Dim objFile Dim strValue '置換対象文字列 Dim lngStart '検索位置 Dim depth '括弧の深さ lngStart = 1 depth = 0 Set objFile = m_objFso.OpenTextFile( l_strItem ) strValue = objFile.ReadAll objFile.Close Do Call replace( lngStart , strValue , depth ) If continue = 0 Then Exit Do End If Loop While 1 Set objFile = m_objFso.OpenTextFile( l_strItem , 2 ) objFile.Write( strValue ) objFile.Close Set objFile = Nothing End Sub '--------------------------------------------------------- Private Function replace( lngStart , strValue , depth ) Dim leftPosition '右括弧の位置 Dim rightPosition '左括弧の位置 leftPosition = InStr( lngStart , strValue , "(") rightPosition = InStr( lngStart , strValue , ")") If rightPosition = 0 Then continue = 0 Exit Function ElseIf leftPosition = 0 Then depth = depth - 1 strValue = Replace( strValue , ")", ")</span>") lngStart = rightPosition + Len("</span>") + 1 ElseIf leftPosition < rightPosition Then depth = depth + 1 If depth = 1 Then strValue = Left( strValue , leftPosition - 1) & "<span style=""color:Aquamarine"">" & mid( strValue , leftPosition ) lngStart = leftPosition + Len("<span style=""color:Aquamarine"">") + 1 Else strValue = Left( strValue , leftPosition - 1) & "<span style=""color:GreenYellow"">" & mid( strValue , leftPosition ) lngStart = leftPosition + Len("<span style=""color:GreenYellow"">") + 1 End If Else depth = depth - 1 strValue = Replace( strValue , ")", ")</span>") lngStart = rightPosition + Len("</span>") + 1 End If continue = leftPosition Or rightPosition End Function また、もっといい方法があれば教えてください。

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

  • ベストアンサー
回答No.1

このスクリプトの仕様が正しいかを確認してない。 とりあえず原因だけ言うと。 *VB系は関数や変数の大文字小文字の差を同一視する。 *標準関数にReplaceが存在し、それを用いている。 *ユーザ側で作った関数の名前も何とReplace *プログラマが標準関数のReplaceを呼ぶつもりで書いているが、このスクリプトは、ユーザーが定義した関数replaceだと思って引数を渡しているため、lngStartがそのような内容になる。 #個人的には If rightPosition = 0 Then Msgbox("3:" & lngStart) continue = 0 Exit Function ElseIf leftPosition = 0 Then End If は If rightPosition = 0 Then Msgbox("3:" & lngStart) continue = 0 Exit Function End If If leftPosition = 0 Then End If としてネストを深くしないようにしたいところか

kimudon750612
質問者

お礼

関数名を変えたらうまくいきました。 標準関数を呼んでいたなんて、思ってもいませんでした。でも、よく考えればreplaceなんてそのままの言葉だし、そうなりますね。 これからは自作関数作るときはオリジナリティあふれる名前にします。 ありがとうございました。

kimudon750612
質問者

補足

Msgbox("3:" & lngStart)はhimajin100000さんが動作確認用に追加したところですよね。 ElseIfはネストが深くなるんですか?

関連するQ&A

  • 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でファイル作成後、書き込みできない

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

    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でフォルダ、ファイル作成時のエラーコード

    フォルダ、ファイルが存在しないとき、作成するスクリプトを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

  • VBSを使用したSQLCMDからのQuit

    VBSを使用してSQLCMDを実行してデータベースに接続できることを確認しましたが、 データベースの切断ができません。 SQLCMDユーティリティに制御が移ってしまっているため、VBSのシェルオブジェクトを使用して切断できないのではと考えております。 ADOを使用すれば、いいのは分かっているのですが、実際の環境ではADOを使用したデータベースへの接続が安定しないため、SQLCMDで接続する方法でスクリプトを作成しました。 何かいい方法がありましたら、ご教示頂けますでしょうか。 Option Explicit '■ オブジェクトの宣言 Dim objFSO Dim objFile Dim objWShell '■ 変数の宣言 Dim strBuf Dim strSearch Dim IngPos Dim IngCnt Dim idx Dim Param(3) Dim Hit Dim HitCnt Dim DBConCmd Dim DisConCmd '■ 定数の宣言 '// データベースコンフィグファイル格納フォルダ Const strDBConfigFolder = "c:\DBConfig" '// データベースコンフィグファイル Const strDBConfigFile = "c:\DBConfig\SQLCMDDBCon.cfg" '// 検索開始位置(1文字目) Const IngStart = 1 '// テキストモードで比較 Const IngTextCmp = 1 On Error Resume Next '□ FSOオブジェクトの作成 Set objFSO = CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then '□ データベースコンフィグファイル格納フォルダの存在チェック If objFSO.FolderExists(strDBConfigFolder) Then WScript.Echo "データベースコンフィグファイルを格納フォルダが存在します" '□ データベースコンフィグファイルの存在チェック If objFSO.FileExists(strDBConfigFile) Then WScript.Echo "データベースコンフィグファイルが存在します" '□ データベースコンフィグファイルの読み込み Set objFile = objFSO.OpenTextFile(strDBConfigFile, 1) '□ データベースコンフィグファイル読み取りチェック If Err.Number = 0 Then WScript.Echo "データベースコンフィグファイルが読み取りできます" '□ ディレクティブをセット strSearch = Array("<server_name>", "<login_id>", "<password>") '□ ヒットカウントの初期化 HitCnt = 0 Do Until objFile.AtEndOfLine = True '□ 1行読み込み、バッファに格納 strBuf = objFile.ReadLine '□ インデックスの初期化 idx = 0 '□ ヒットフラグの初期化 Hit = 0 '□ ディレクティブヒット判定用の初期化 IngPos = 0 Do Until idx > 2 or Hit = 1 IngPos = Instr(IngStart, strBuf, strSearch(idx), IngTextCmp) If IngPos = 0 Then WScript.Echo strSearch(idx) & "が見つかりません" idx = idx + 1 Else WScript.Echo strSearch(idx) & "が見つかりました" IngCnt = Len(strSearch(idx)) Param(idx) = Mid (strBuf, IngCnt + 1) Hit = 1 HitCnt = HitCnt + 1 End If Loop Loop Else WScript.Echo "データベースコンフィグファイルが読み取りできまないため、処理を終了します" WScript.Quit(1) End If Else WScript.Echo "データベースコンフィグファイルが存在しないため、処理を終了します" WScript.Quit(1) End If Else WScript.Echo "データベースコンフィグファイルを格納フォルダが存在しないため、処理を終了します" WScript.Quit(1) End If Else WScript.Echo "FSOオブジェクトが作成できないため、処理を終了します" WScript.Quit(1) End If '□ Shellオブジェクトの作成 Set objWShell = WScript.CreateObject("WScript.Shell") If Err.Number = 0 Then DBConCmd = "sqlcmd -S " & Param(0) & " -U " & Param(1) & " -P " & Param(2) objWShell.run DBConCmd If Err.Number = 0 Then WScript.Echo "データベースサーバーに接続しました" Else WScript.Echo "データベースサーバーに接続できませんでしたので、処理を終了します" WScript.Quit(1) End If Else WScript.Echo "Shellオブジェクトが作成できないため、処理を終了します" WScript.Quit(1) End If DBDisConCmd = "exit" objWShell.run DBDisConCmd '□ オブジェクトのクローズ objFile.Close '□ オブジェクトの開放 Set objShell = Nothing Set objFSO = Nothing

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

  • 【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ファイルを実行することにより入力ボックスが表示され、 入力ボックスに文字列を入力すると、 「Active.csv」というファイルに 『現在の時間』と『入力文字列』が出力されます。 このVBSスクリプト内に入力ボックスにて「OK」を 押したときの時間を拾っていれたいと思っております。 どのような手法が考えられますでしょうか? ご教授のほど、よろしくお願いします。 Option Explicit On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル書き込み用 Dim Reason ' ファイル入力 Reason = InputBox("何かいれてください。") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile("Active.csv", 8, True) If Err.Number = 0 Then objFile.Write(Date()) objFile.Write(",") objFile.Write(Time()) objFile.Write(",") objFile.Write(Reason) objFile.Write(",") 'ここに入力ボックスにて「OK」を押したときの時間を拾っていれたいです。 objFile.Write(",") objFile.Write(vbNewLine) objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If

  • ファイル書き込み

    out.csvファイルに追記していくにはどのように記述すればいいのでしょうか? アドバイス下さい。 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("c:\test.csv") 'objFile.ReadLine Do While Not objFile.AtEndOfStream StrLine = objFile.ReadLine MyString = split(StrLine,",") ' msgbox Mid(MyString(0),2,10) ' MyString = split(objFile.ReadLine,",") if Mid(MyString(0),2,10) = "(PDH-CSV 4" then Set objWFile=objFSO.OpenTextFile("c:\out.csv",2,true) objWFile.write(StrLine) msgbox "!!!" end if ' if Mid(MyString(0),2,10) = DateString then Set objWFile=objFSO.OpenTextFile("c:\out.csv",2,true) objWFile.write(StrLine) ' 'msgbox Mid(MyString(0),2,10) msgbox "???" end if loop objFile.close Set objFSO = Nothing Set objFile = Nothing

  • ファイルを探すプログラムで 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