VB 正则提取内容～～紧急求助!!!

[SungCen]

文本格式这样的

<ul class="members">
<li><a href="http://wpa.qq.com/msgrd?V=1&Uin=992992&Site=群空间&Menu=yes" target="_blank" title=" 相 信"><img src="http://qun.qq.com/cgi/svr/face/getface?type=1&uin=992992" width="20" height="20" align="absmiddle" class="no" />
相 信 </a>
</li>
<li><a href="http://wpa.qq.com/msgrd?V=1&Uin=342190514&Site=群空间&Menu=yes" target="_blank" title="振东方"><img src="http://qun.qq.com/cgi/svr/face/getface?type=1&uin=342190514" width="20" height="20" align="absmiddle" class="no" />
振东方 </a>
</li>
</ul>


我想写个VB小程序怎么能够把内容中QQ号提取，并存放到一个文件里面啊？

请高手的帮下偶～～急用～～

[zhufenghappy]

你在窗体加一个，Command1，两个文本框Text1、Text2，把你要提取的文本拷贝到Text1，点Command1，就可以看到你要的结果在Text2里（前提是你的格式就是你说的那样，如果出现和代码中判断的字符不符的可以修改）
Private Sub Command1_Click()
Dim Arr() As String
Dim i As Integer
Dim iStart As Long, iEnd As Long
Text2.Text = ""
Arr = Split(Text1.Text, "</li>")
For i = 0 To UBound(Arr) - 1
iStart = InStr(Arr(i), "V=1&Uin=") + 8
iEnd = InStr(Arr(i), "&Site=")
Debug.Print Mid(Arr(i), iStart, (iEnd - iStart))
Text2.Text = Text2.Text & ", " & Mid(Arr(i), iStart, (iEnd - iStart))
Text2.Text = Mid(Text2.Text, 2)
Next
End Sub

[verywzm]

帮顶

[sonic_andy]

set fso = createobject("scripting.filesystemobject")
set stream = fso.opentextfile("input.txt",1)
content = stream.readall
call stream.close

set reg = new regexp
reg.global = true
reg.pattern = "uin=(\d+)"
set matches = reg.execute(content)

for each match in matches
    result = result & match.submatches(0) & vbcrlf
next

set stream = fso.opentextfile("output.txt",2,true)
call stream.write(result)
call stream.close

[sonic_andy]

以上内容存为vbs,将input.txt修改为实际的文件名,然后双击运行即可.

[lili830209]

mark

[dlschan]

mark

[SYSSZ]

引用Microsoft VBScript Regular Expressions 5.5.
'两文本框设为多行显示
'将你的文本粘贴到Text1
Private Sub Command1_Click()
Dim re As RegExp
    Dim mh As Match
    Dim mhs As MatchCollection
    Dim inpStr As String
    inpStr = Text1.Text
Set re = New RegExp
     re.Pattern = "\d{9}|\d{6}"
re.IgnoreCase = True
re.Global = 2
    Set mhs = re.Execute(inpStr)
    
    For Each Match In mhs
  S = S & Match.Value & vbCrLf
    Next
   Text2.Text = S
End Sub

[ningyong58]

关注四则运算的帖子。

[a271878991]

友情~~~~帮顶~~~