前提・実現したいこと
id要素の入ったnavタグをVBAマクロで範囲削除したいのですが、
一向にできません。
イメージとしましては、以下のようにnavタグの中にあるもの
全て削除されることを想定しております。
<header></header> <nav id="hogehoge"> <ul> <li></li> (中略) <li></li> </ul> </nav> <footer></footer>
▼
<header></header> <footer></footer>
発生している問題・エラーメッセージ
以下のコードを書いているのですが、範囲削除がうまく出力されません。
該当のソースコード
' ---------------------------------------------- ' 概要: ' <開始タグ>~<終了タグ>の範囲を削除する ' ' @parm なし ' @return なし ' ' ---------------------------------------------- Sub 開始タグから終了タグの範囲削除() Dim buf As String ' 編集したhtml文の文字列 Dim fname As String ' ファイル名 Dim skip_flg As Boolean ' ファイル名 Dim folderPath As String ' フォルダパス Dim filePath As String ' ファイルパス(フルパス) Dim outPath As String ' ファイルパス(フルパス) Dim outFolderPath As String ' フォルダパス Dim row As Long ' 行 ' ---------------------------------------------- ' html出力フォルダを作成 ' ---------------------------------------------- folderPath = Cells(7, 3).MergeArea(1, 1).Value ' 結合セルのC7セルの値を取得し、変数に代入 If Dir(folderPath, vbDirectory) = "" Then MsgBox "指定された格納先パスが存在しません。処理を終了します。" GoTo ErrEnd End If outFolderPath = folderPath & "\output" If Dir(outFolderPath, vbDirectory) = "" Then MkDir outFolderPath End If ' ---------------------------------------------- ' 項番が空文字になるまでループ ' ---------------------------------------------- row = START_ROW Do While Cells(row + 1, 2) <> "" row = row + 1 folderPath = Cells(row, 3) ' フォルダパス取得 fname = Cells(row, 4) ' ファイル名取得 filePath = folderPath & "\" & fname 'ファイルパスを設定 starTagFlg = False Dim tobj As Object Set tobj = CreateObject("ADODB.Stream") tobj.Charset = "UTF-8" tobj.LineSeparator = 10 tobj.Open tobj.LoadFromFile filePath Do Until tobj.EOS tmp = tobj.ReadText(-2) ' htmlファイルから一行読み込む If starTagFlg = True Then If tmp Like "</nav>*" Then ' 複数行に最終タグがあるか判定 starTagFlg = False End If ElseIf tmp Like "<nav id=""hogehoge"">*" Then ' 削除対象の開始タグか判定 If Not tmp Like "<nav id=""hogehoge"">*</nav>*" Then ' 1行に最終タグがあるか判定 starTagFlg = True End If Else buf = buf & tmp End If Loop tobj.Close Set tobj = Nothing If starTagFlg = True Then Cells(row, 5) = "削除対象の終了タグが発見できませんでした。ファイル未出力です。" Else outPath = outFolderPath & "\" & fname '出力先のファイルパスを設定 Set tobj = CreateObject("ADODB.Stream") tobj.Charset = "UTF-8" tobj.LineSeparator = 10 tobj.Open tobj.WriteText buf tobj.SaveToFile outPath, 2 tobj.Close Set tobj = Nothing Cells(row, 5) = "ファイルを出力しました。" End If Loop ErrEnd: End Sub
VBA初心者なので、原因が全くわかりません。
大変恐れ入りますが、皆様のお知恵をお借りできればと存じます。
何卒よろしくお願いいたします。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。