hpサイトの情報をtxtで保存するには (ID:78247)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

暇人なので、こんなものを書いて見ました(笑)
&amp;とかの変換はしていません
関数二つは一つにすることができますが、
引数チェックがめんどうだったので(笑)
遊びで作ったので、否定的な意見は勘弁してください ( ;o;)ノ

(Form)Textボックス1つ-MultiLine、ボタン1つ
Private Sub Command1_Click()

Dim txt As String
Dim tmp As String
Open "Filename.htm" For Input As #1
txt = ""
While EOF(1) = False
    Line Input #1, tmp
    txt = txt & vbCrLf & tmp
    Call EraseHTMLcomment(txt)
    Call EraseAnyTag(txt)
    Text1.Text = txt
Wend

End Sub

Public Function EraseHTMLcomment(ByRef strDat As String)
    Dim StartPos As Long
    Dim EndPos As Long
    Dim tmpStr As String
    StartPos = InStr(strDat, "")
        If EndPos > StartPos + 2 Then
            If StartPos <> 1 Then 'コメント以前
                tmpStr = Left(strDat, StartPos - 1)
            Else
                tmpStr = ""
            End If
            
            If Len(strDat) > EndPos + 2 Then 'コメント後
                tmpStr = tmpStr & Mid(strDat, EndPos + 3)
            End If
            strDat = tmpStr
            StartPos = InStr(StartPos, strDat, "<!--")
        Else
            StartPos = 0
        End If

Wend

End Function

Public Function EraseAnyTag(ByRef strDat As String)
    Dim StartPos As Long
    Dim EndPos As Long
    Dim tmpStr As String
    StartPos = InStr(strDat, "<")
    
    While StartPos <> 0
        EndPos = InStr(StartPos, strDat, ">")
        If EndPos > StartPos Then
            If StartPos <> 1 Then 'タグ前
                tmpStr = Left(strDat, StartPos - 1)
            Else
                tmpStr = ""
            End If
            
            If Len(strDat) > EndPos Then 'タグ後
                tmpStr = tmpStr & Mid(strDat, EndPos + 1)
            End If
            strDat = tmpStr
            StartPos = InStr(StartPos, strDat, "<")
        Else
            StartPos = 0
        End If
        
    Wend
End Function

←解決時は質問者本人がここをチェックしてください。

戻る