by DmR (2 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 14th February 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
I've called this program - MailFilter. It opens input file and catch all mail addresses there. Finally, it appends them into output file.
VBcoders
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "MailFilter"
ClientHeight = 2505
ClientLeft = 60
ClientTop = 345
ClientWidth = 7905
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2505
ScaleWidth = 7905
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtSavedFileName
Height = 315
Left = 60
TabIndex = 4
TabStop = 0 'False
Text = "Output File Name"
Top = 1320
Width = 7695
End
Begin VB.CommandButton cmdSavedFileName
Caption = "&Save As"
Height = 315
Left = 6360
TabIndex = 1
Top = 960
Width = 1395
End
Begin VB.CommandButton cmdOpenFile
Caption = "&Open File"
Height = 315
Left = 6360
TabIndex = 0
Top = 180
Width = 1395
End
Begin MSComDlg.CommonDialog dlgFile
Left = 1140
Top = 5760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdDo
Caption = "&DoIt!"
Height = 495
Left = 60
TabIndex = 2
Top = 1860
Width = 6795
End
Begin VB.TextBox txtFileName
Height = 315
Left = 60
TabIndex = 3
TabStop = 0 'False
Text = "Input File Name"
Top = 540
Width = 7695
End
Begin VB.Shape shpGreen
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 495
Left = 7020
Shape = 3 'Circle
Top = 1860
Visible = 0 'False
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'--------------------------------------------
' This programs opens file strFileName
' and then starts to catch all mail adresses
' Then it put them into another file
' with name strSavedFileName
'--------------------------------------------
' Author: DmR
' Date 14.02.2004
'--------------------------------------------
Option Explicit
Option Compare Text
Dim strFileName As String
Dim strSavedFileName As String
Private Sub cmdDo_Click()
Dim strFileContext As String
Dim bResult As Boolean
Dim Strs() As String
Dim Words() As String
Dim i As Long
Dim j As Long
Dim fnum As Integer
Dim isOpen As Boolean
If Len(strSavedFileName) * Len(strFileName) = 0 Then
shpGreen.FillColor = &HFF
shpGreen.Visible = True
Exit Sub
End If
If StrComp(strSavedFileName, strFileName, vbTextCompare) = 0 Then
shpGreen.FillColor = &HFF
shpGreen.Visible = True
Exit Sub
End If
On Error GoTo Error_Handler
fnum = FreeFile()
Open strSavedFileName For Append As #fnum
isOpen = True
strFileContext = ReadTextFileContents(strFileName)
Strs() = Split(strFileContext, vbCrLf)
For i = LBound(Strs) To UBound(Strs)
Debug.Print "String (" & i & ") = " & Strs(i)
Words() = Split(Strs(i), " ")
For j = LBound(Words) To UBound(Words)
Words(j) = Replace(Words(j), vbTab, "")
Debug.Print "Words (" & j & ") = " & Words(j)
If (Words(j) Like "*@*.net") Or _
(Words(j) Like "*@*.co.il") Or _
(Words(j) Like "*@*.org") Or _
(Words(j) Like "*@*.com") Then
Print #fnum, Words(j)
End If
Next j
Next i
Error_Handler:
If isOpen Then Close #fnum
If Err Then Err.Raise Err.Number, , Err.Description
shpGreen.FillColor = &HFF00&
shpGreen.Visible = True
End Sub
Private Sub cmdOpenFile_Click()
strFileName = GetFile()
txtFileName.Text = strFileName
End Sub
Function GetFile() As String
dlgFile.CancelError = True
On Error GoTo filerr
dlgFile.DialogTitle = "Choose a file name..."
dlgFile.DefaultExt = "*.*"
dlgFile.Filter = "All Files (*.*)|*.*"
dlgFile.FilterIndex = 1
'dlgFile.MaxFileSize = 1500000
dlgFile.ShowOpen
GetFile = dlgFile.filename
Exit Function
filerr:
MsgBox "Err", vbOKOnly, "Err"
GetFile = ""
End Function
Private Sub cmdSavedFileName_Click()
strSavedFileName = GetFile()
txtSavedFileName.Text = strSavedFileName
End Sub
Attribute VB_Name = "Module1"
Function ReadTextFileContents(filename As String) As String
Dim fnum As Integer, isOpen As Boolean
On Error GoTo Error_Handler
fnum = FreeFile()
Open filename For Input As #fnum
isOpen = True
ReadTextFileContents = Input(LOF(fnum), fnum)
Error_Handler:
If isOpen Then Close #fnum
If Err Then Err.Raise Err.Number, , Err.Description
End Function
No comments have been posted about I've called this program - MailFilter. It opens input file and catch all mail addresses there. Fina. Why not be the first to post a comment about I've called this program - MailFilter. It opens input file and catch all mail addresses there. Fina.