【引き込まれるwiki総合：３】 ３

>>129 のプログラム【改正版】です。すみません。
---------------------------------------------------------------------------
Public Function URLDecodeUTF8(strSource As String) As String
Dim objSC As Object
On Error GoTo brokencode
Set objSC = CreateObject("ScriptControl")
objSC.Language = "Jscript"
URLDecodeUTF8 = objSC.CodeObject.decodeURIComponent(strSource)
Set objSC = Nothing
Exit Function
brokencode: URLDecodeUTF8 = "■■■"
End Function
Sub wikilist()
Dim a, b, c As String: Dim p, q As Long
Open "c:¥wikiin.txt" For Input As #1
Open "c:¥wikiout.txt" For Output As #2
Do
Line Input #1, a: p = InStr(a, "ht" + "tp://ja.wikipedia.org/wiki/")
If p > 0 Then
b = URLDecodeUTF8(Mid(a, p + 29)): b = RTrim(Replace(b, "_", " "))
q = InStr(b, "#"): If q > 0 Then b = Left(b, q - 1)
c = c + b + "／": If Len(c) > 50 Then Print #2, c: c = ""
End If
Loop Until EOF(1)
Print #2, c: Close #2: Close #1
End Sub
----------------------------------------------------------------------------
リンクが壊れている場合は「■■■」を吐き出すようにしました。
ついでに処理を少しだけ効率化しました。
画像のような感じに出力されます。スレ汚し失礼。

返信する