->電子郵件(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地址。->->
