-电子邮件(EMAIL)是INTERNET上应用最广泛的一种服务之一。我们每天都在使用电子邮件，有时为了宣传我们的产品、网站等，更是离不开电子邮件，这就需要收集很多的EMAIL地址。下面我们将向大家介绍用VB自编一个EMAIL地址提取器，用来提取保存在我们硬盘中的HTML文件中所包含的EMAIL地址。--一设计界面--进入VB，选择“标准EXE”新建一工程，选择“工程”菜单下的“引用”，选中MicrosoftscriptingRuntime”，然后再选择“工程”菜单中的“部件”，在弹出的对话框中选择“Microsoftcommondialogcontrol6.0”，在工具箱中加入通用对话框控件。接下来在默认窗体FORM1上添加三个标签控件，一个文本框控件text1，一个列表框控件LIST1，并命名为lstemail，三个命令command1~command3,其Caption属性分别设置为“提取”、“整理”、“保存”，设置完成的界面如下图所示：--
----二输入源程序--DimX,Y,St1,St2,tmpYAsInteger--'提取EMAIL地址子程序--PrivateSubStripEmail(FilePathAsString)--DimtmpEmail1,tmpEmail2AsString--OpenFilePathForInputAs#1--DoUntilEOF(1)--OnErrorResumeNext--Input#1,tmpEmail1--ForX=1ToLen(tmpEmail1)--tmpEmail2=Mid(tmpEmail1,X,7)--'查找EMAIL标志--IftmpEmail2="mailto:"Then--St1=X--tmpY=X 1--ForY=1ToLen(tmpEmail1)--tmpEmail2=Mid(tmpEmail1,tmpY,1)--IftmpEmail2=Chr(34)OrtmpEmail2="?"Then--St2=tmpY--tmpEmail2=Mid(tmpEmail1,St1 7,((St2-St1)-7))--If(Left(tmpEmail2,2)<>"//")And(Left(tmpEmail2,1)<>"")Then--lstEmail.AddItemtmpEmail2--ExitFor--EndIf--EndIf--tmpY=tmpY 1--NextY--EndIf--NextX--Loop--Close#1--EndSub--PrivateSubCommand1_Click()--DimfsAsNewFileSystemObject'建立FileSystemObject--DimfdAsFolder'定义Folder对象--DimsfdAsFolder--Setfd=fs.GetFolder(Text1)--Command1.Enabled=False--Screen.MousePointer=vbHourglass--FindFilefd,"*.htm"'Text1.Text--Command1.Enabled=True--Screen.MousePointer=vbDefault--EndSub--SubFindFile(fdAsFolder,FileNameAsString)--DimsfdAsFolder,fAsFile--'PartI查找该文件夹的所有文件--ForEachfInfd.Files--IfUCase(f.Name)LikeUCase(FileName)Then--Label2=f.Path--StripEmail(f.Path)--lblEmail="已查找到的地址数为:"&lstEmail.ListCount--EndIf--DoEvents--Next--'PartII循环查找所有子文件夹--ForEachsfdInfd.SubFolders--FindFilesfd,FileName'循环查找--Next--EndSub----PrivateSubCommand2_Click()--'去掉重复的EMAIL地址--Fori=0TolstEmail.ListCount-1--ForX=0TolstEmail.ListCount-1--Ifi=XThenGoToNextx--IfLCase(lstEmail.List(X))=LCase(lstEmail.List(i))Then--OnErrorResumeNext--lstEmail.RemoveItemX--EndIf--Nextx:--NextX--Nexti--lblEmail="共有"&lstEmail.ListCount&"个地址"--EndSub--'保存--PrivateSubCommand3_Click()--'设置文件名--DimstrnameAsString--commondialog1.Filter="文本文件(*.txt)|*.txt"--commondialog1.ShowSave--Ifcommondialog1.FileName<>""Then--strname=commondialog1.FileName--Else--strname=App.Path&"\emailaddress.txt"--EndIf--'保存文件--OpenstrnameForOutputAs#1--OnErrorResumeNext--Fori=0TolstEmail.ListCount-1--Print#1,lstEmail.List(i)--Next--Close#1--EndSub--本程序在WINDOWSME、VB6.0中文企业版中运行通过。以上程序稍加修改即可实现提取其他类型文件中的EMAIL地址。--
