Using VB to extract email address in HTML file

e-mail (email) is one of the most widely used services on the Internet. We use e-mail every day, sometimes in order to promote our products, websites, etc., is inseparable from e-mail, which requires a lot of email address collection. Below we will introduce the use of VB to edit an email address extractor, used to extract the saved in our hard disk in the HTML file contained in the email address.

　　 a design interface

Into the VB, select "Standard EXE" new project, select the "Project" menu under the "Reference", select Microsoft Scripting Runtime, and then select the "Project" menu "part", in the pop-up dialog box, select Microsoft Common Dialog Control 6.0, add a common dialog box to the Toolbox. Next, add three label controls on the default form FORM1, a text box control Text1, a list box control LIST1, and named Lstemail, three command Command1~command3 with caption properties set to extract, organize, Save, set the finished interface as shown in the following illustration:


　　 two input source program

Dim X, Y, St1, St2, tmpy as Integer ' Extract email Address subroutine Private Sub Stripemail (FilePath as String) Dim TmpEmail1, TmpEmail2 as String Open FilePath for Input as #1 Do Until EOF (1) On Error Resume Next Input #1, TmpEmail1 For X = 1 to Len (TMPEMAIL1) TMPEMAIL2 = Mid (TmpEmail1, X, 7) ' Find email logo If tmpEmail2 = "mailto:" Then ST1 = X Tmpy = X + 1 For Y = 1 to Len (TMPEMAIL1) TMPEMAIL2 = Mid (TmpEmail1, Tmpy, 1) If tmpEmail2 = Chr or TmpEmail2 = "?" Then St2 = Tmpy TMPEMAIL2 = Mid (tmpEmail1, St1 + 7, ((ST2-ST1)-7)) If (Left (TMPEMAIL2, 2) <> "//") and (left (TMPEMAIL2, 1) <> "") Then Lstemail.additem TMPEMAIL2 Exit for End If End If Tmpy = tmpy + 1 Next Y End If Next X Loop Close #1 End Sub Private Sub Command1_Click () Dim FS as New FileSystemObject ' build FileSystemObject Dim FD as folder ' defines a folder object Dim SFD as Folder Set FD = fs. GetFolder (TEXT1) command1.enabled = False Screen.MousePointer = Vbhourglass FindFile fd, "*.htm" ' Text1.Text command1.enabled = True Screen.MousePointer = Vbdefault End Sub Sub FindFile (fd as Folder, FileName as String) Dim SFD as Folder, F as File ' Part I find all files in this folder For each f in FD. Files If UCase (f.name) like UCase (FileName) Then Label2 = F.path Stripemail (F.path) Lblemail = "The number of addresses found is:" & Lstemail.listcount End If DoEvents Next ' Part Ii loop to find all subfolders For each SFD in FD. Subfolders FindFile sfd, FileName ' Loop lookup Next End Sub  Private Sub Command2_Click () ' Remove the duplicate email address For i = 0 to Lstemail.listcount-1 For X = 0 to Lstemail.listcount-1 If i = X Then GoTo nextx If LCase (Lstemail.list (X)) = LCase (Lstemail.list (i)) Then On Error Resume Next Lstemail.removeitem X End If NEXTX: Next X Next I Lblemail = "Total" & Lstemail.listcount & "Address" End Sub ' Save Private Sub Command3_Click () ' Set file name Dim strname as String Commondialog1. Filter = "text file (*.txt) |*.txt" Commondialog1. Showsave If Commondialog1. FileName <> "" Then strname = Commondialog1. FileName Else strname = App.Path & "\emailaddress.txt" End If ' Save file Open strname for Output as #1 On Error Resume Next For i = 0 to Lstemail.listcount-1 Print #1, lstemail.list (i) Next Close #1 End Sub

This program runs in the Windows ME, VB6.0 Chinese Enterprise Edition. The above program can be slightly modified to achieve the extraction of other types of files in the email address.