->->->->二输入源程序->->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地址。->
->