• Home
 · 
• Miscellaneous
 · 
• I've called this program - MailFilter. It opens input file and catch all mail addresses there. Fina

I've called this program - MailFilter. It opens input file and catch all mail addresses there. Fina

I've called this program - MailFilter. It opens input file and catch all mail addresses there. Finally, it appends them into output file.

Rate I've called this program - MailFilter. It opens input file and catch all mail addresses there. Fina

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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