Tutorials to .com

Tutorials to .com » Software » Vb » Extraction of HTML files using VB in the EMAIL address

Extraction of HTML files using VB in the EMAIL address

Print View , by: iSee ,Total views: 27 ,Word Count: 773 ,Date: Wed, 26 Aug 2009 Time: 4:10 AM


Heilongjiang Province Agriculture School of Economics Wei-Dong Jiang Huayun

E-mail (EMAIL) is the INTERNET's most extensive one of a service. Every day we are using the e-mail, sometimes in order to promote our products, websites, etc., but also inseparable from the e-mail, which need to collect a lot of EMAIL addresses. Here we will introduce an EMAIL address self-compiled with vb Extractor to extract stored in our hard drive in the HTML file contained in the EMAIL address.
Designed to interface into a VB, select "Standard EXE" a new project, select "Project" menu under "reference", select the Microsoft scripting Runtime ", then select" project "menu in the" components "in the pop-up dialog box, select "Microsoft common dialog control 6.0", in the toolbox to add Common Dialog control. then the default form, add three labels FORM1 controls, a text box control, text1, a list box control LIST1, and named To lstemail, three command command1 ~ command3, respectively, of its Caption property set to "extract", "order", "Save",

2 input source
Dim X, Y, St1, St2, tmpY As Integer
'Extract the EMAIL address of 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 flag
If tmpEmail2 = "mailto:" Then
St1 = X
tmpY = X + 1
For Y = 1 To Len (tmpEmail1)
tmpEmail2 = Mid (tmpEmail1, tmpY, 1)
If tmpEmail2 = Chr (34) 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 'to establish FileSystemObject
Dim fd As Folder 'definition of Folder objects
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  to find all the files in the folder
For Each f In fd.Files
If UCase (f.Name) Like UCase (FileName) Then
Label2 = f.Path
StripEmail (f.Path)
lblEmail = "find the number of addresses have been as:" & lstEmail.ListCount
End If
DoEvents
Next
'Part II  loop to find all sub-folders
For Each sfd In fd.SubFolders
FindFile sfd, FileName 'loop to find
Next
End Sub

Private Sub Command2_Click ()
'Remove 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 & "addresses"
End Sub
'Save
Private Sub Command3_Click ()
'Set the file name
Dim strname As String
commondialog1.Filter = "Text Files (*. txt) | *. txt"
commondialog1.ShowSave
If commondialog1.FileName <> "" Then
strname = commondialog1.FileName
Else
strname = App.Path & "\ emailaddress.txt"
End If
'Save the 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
The program in WINDOWS ME, VB6.0 run by the Chinese Enterprise Edition. Slightly modify the above procedures can be realized in other types of files extracted in the EMAIL address.


Visual Basic Tutorial Articles


Can't Find What You're Looking For?


Rating: Not yet rated

Comments

No comments posted.