テキストファイルの中からURLを抽出するには？

ＶＢＡで読み込んだテキストファイルからＵＲＬ部分だけを抽出するにはどうしたらよいでしょうか？
InStr関数とMid関数を使って、先頭：http～終わり：空白 or Chr(13)をURLとして切り取っているのですがうまく行きません。
どうも終わり部分の判定が甘いようです。

Sub GetURL(myText) 　　　　'テキストからURLを抽出
　Dim myText As String
　Dim myURL As String　　　'URL取り込み用
　Dim str_pt As Long　　　　　'文字列用ポインタ
　str_pt = 1　　　　　　　　　　'最初は1文字目から
　Do While 1
　　str_pt = InStr(str_pt, myText, "http")
　　If str_pt = 0 Then Exit Do
　　Do While 1
　　　letter = Mid(myText, str_pt, 1)
　　　If letter = Chr(20) Or letter = Chr(13) Then Exit Do
　　　myURL = myURL & letter
　　　str_pt = str_pt + 1
　　Loop
　　Debug.Print myURL
　　myURL = ""
　Loop
End Sub

アドバイスをお願いします！

No.3 ベストアンサー 回答者： masa_pee 回答日時： 2006/02/24 07:47

#2さんの答えを引き継いで正規表現でやってみました。

使えるかどうかは環境によります(IE5.0以降かな？)

以下のコードは読みやすいように行頭に全角スペースが入っています。実際に動かすときは半角にしてください。

Sub test()
　Dim teststr As String
　teststr = "URL抽出のテスト" & vbCrLf & _
　　　　　　　"URLは http://example.com/aaa/bbb/ccc/index.html です。" & vbCrLf & _
　　　　　　　"URLは https://example.com/xxx/yyy/zzz/index.php" & _
　　　　　　　" または https://example.com/XXX/yyy/zzz/ です。" & vbCrLf & _
　　　　　　　"URLはhttpまたはhttps で始まります。"
　GetUrl teststr
End Sub
Sub GetUrl(str)
　Dim reg, matches, match
　Dim strPat As String

　Set reg = CreateObject("VBScript.RegExp")
　strPat = "https?:\/\/[0-9a-zA-Z,;:~&=@_'%?+\-/$.!*()]+" ' (1) これが正規表現の検索パターン

　reg.Pattern = strPat
　reg.Global = True

　Set matches = reg.Execute(str) ' マッチしたコレクション
　For Each match In matches ' マッチした文字列を一つずつ取り出す
　　Debug.Print match.Value
　Next

　Set matches = Nothing
　Set reg = Nothing
End Sub

==== 結果 ===================================
http://example.com/aaa/bbb/ccc/index.html
https://example.com/xxx/yyy/zzz/index.php
https://example.com/xxx/yyy/zzz/

正規表現を使ったことないとややこしく見えるかもしれませんが、検索パターンが変わっても(1)を書き換えるだけで済みます。例えばURLには ftp:// とかもあるわけですが、必要になっても(1)を書き換えるだけです。あとの行はまあお決まりなので、この際覚えておくと楽ですよ。正規表現はVB系の話だけではないのでこれから他の言語を覚えるときも役に立ちますしね。

詳しいことは「VBA 正規表現」で検索するといろいろ出てくるので見てください。とりあえず一つだけURL挙げときます。

参考URL：http://www.officetanaka.net/excel/vba/tips/tips3 …

この回答へのお礼

丁寧にサンプルまで作成していただき感謝！！
やはり正規表現を勉強しないと駄目なんですね。
なんとなく面倒で避けてました。
なぜ上記のプログラムで動くのか読みきれていませんが、とりあえずは大助かりです！
ありがとうございました。

お礼日時：2006/02/24 09:13

No.2 回答者： corocoro1616 回答日時： 2006/02/23 23:46

VBAではVB Scriptって呼び出せたかな?

VBからはやったことがあるが
VB Scriptを呼び出せるなら
正規表現が手っ取り早いですね。
$main_text =~ s/(http:\/\/[\w\d\/%#$\&?()~_\.:=+\-!]+)/<A HREF=\"$1\" target=\"_blank\" class=\"main_link\">[リンク]<\/A>/g;
$main_text =~ s/(https:\/\/[\w\d\/%#$\&?()~_\.:=+\-!]+)/<A HREF=\"$1\" target=\"_blank\" class=\"main_link\">[リンク]<\/A>/g;
自分が以前Perlで使ったURLをリンクに置換する正規表現です。
VB Scriptは詳しくないのでわかりませんが
一応説明すると正規表現でマッチしたものが
$1(特殊変数)に格納される形です。
VB Scriptではそこの所をどう表現して書くのか
わかりませんが

この回答へのお礼

VB Scriptというのはやったことがないので、ちょっと・・・？Perlも同じく・・・
我ながら不勉強を痛感します。HTMLのような表記なんですね。
残念ながら理解できませんでしたが、やはり正規表現は避けて通れないらしい・・・？
ちょっと勉強してみます。ありがとうございました！

お礼日時：2006/02/24 09:21

No.1 回答者： papayuka 回答日時： 2006/02/23 23:16

Chr(32) Or Chr(10) じゃないですか？

あと、最後まで見つからない時は Do を抜ける必要があると思います。
２つめの Do のところを

Do While str_pt <= Len(myText)
　 letter = Mid(myText, str_pt, 1)
　 Select Case letter
　　Case " ", "　", vbCr, vbLf, vbCrLf: Exit Do
　 End Select

のようにしたら如何でしょう？

この回答へのお礼

早速のアドバイスありがとうございます。

>Chr(32) Or Chr(10) じゃないですか？
Chr(13)はvbCrのつもりです。Chr(20)は半角スペースですね・・・・この2種類でURLのお尻と判断させています。Chr(10)=vbLfは無視しました。URLの終わりが曖昧なので、抽出が完璧ではありませんでした。（９０％以上はOKなのですが）

サンプルで書いていただいたように全角のスペースもありえますね！確かに教えていただいたプログラムの方が安全かもしれません。（私のはいかにもアマっぽい・・・）
ただ、下記のような書き方のURLが抽出できない点は同じです。

例：下記のURL(http://www.goo.ne.jp)を御参照ください。

このようにURLに続けて文章が来ていると切れ目が判別不能な訳です。ですから「URLには含まれないはずの文字」が知りたいという質問です。
何か一発で抽出するような関数があってもいいように思うのですが・・・・
最近では漢字（2バイト文字）のURLもありのようですし、決まりごとはないのでしょうか？

お礼日時：2006/02/24 09:48