人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

メール本文の中からメールアドレス抽出のみを抽出するツールを探しています。

メールソフトのベッキーからエクスポートした、
テキストファイルから数万件のメールアドレスのみを抽出したいと思っています。

機能的にはアットコピア( http://atcopier.com/ )というソフトで解決しそうなのですが
シェアウェアなので、フリーソフトで探しております。

同様の機能を持ったソフリーソフトフトや正規表現などを駆使した方法などを
教えてください。

●質問者: atiran
●カテゴリ:コンピュータ インターネット
✍キーワード:エクスポート シェアウェア ソフト テキスト ファイル
○ 状態 :終了
└ 回答数 : 6/6件

▽最新の回答へ

1 ● tamo2_xvi
●15ポイント

http://www.vector.co.jp/soft/win95/net/se085324.html?g

このソフトは如何でしょうか?

◎質問者からの返答

ありがとうございます。

すこし操作が難しいです。


2 ● llusall
●300ポイント

以下の内容をメモ帳などで[アドレス取得.vbs]などと名前をつけて、デスクトップに配置。

[■抽出たアドレスを入れるファイル名]を修正。

アイコンに、テキストファイルをドラッグ&ドロップしてください。

※まとめてドロップできますが、数万ファイルは、1度にドロップしないでください。

いくつまで、OKかはわかりません。


'ここから-----------------------------------------------------------------

Option Explicit

Const ADDR_FILE = "D:\KEKKA.TXT" '■抽出たアドレスを入れるファイル名

Call Main()

Sub Main()

    Dim objArgs

    Dim i

    Dim nArgCnt

    Dim bRtn

    Dim sPath

    Dim objFS, objTXT, objTXT2, sLine

    Dim reg, Matches, mc, cnt

    Err.Clear

    'コマンドライン引数の有無チェック

    Set objArgs = WScript.Arguments

    nArgCnt = objArgs.Count

    If nArgCnt = 0 Then

        MsgBox "アイコンにファイルをドラッグ&ドロップしてください。", vbExclamation

        Exit Sub

    End If

    Set reg = New RegExp

    reg.Global = True

    reg.Pattern =  "([\w]+)([\w\.-]+)@([\w\-]+)\.([\w\.\-]*)[a-z][a-z]"

    Set objFS   = CreateObject("Scripting.FileSystemObject")

    Set objTXT2 = objFS.CreateTextFile( ADDR_FILE , True )

    'ファイル数の処理を実行

    cnt = 0

    For i = 0 To nArgCnt -1

        sPath = objArgs(i)

        Set objTXT  = objFS.OpenTextFile( sPath, 1, False )

        Do Until objTXT.AtEndOfStream

            sLine = objTXT.ReadLine

            Set Matches = reg.Execute(sLine)

            For Each mc in Matches

                objTXT2.WriteLine(mc.Value)

                cnt = cnt + 1

            Next

        Loop

        objTXT.Close

        Set objTXT  = Nothing

    Next

    objTXT2.Close

    Set objTXT2 = Nothing

    MsgBox "おしまい。[" & cnt & "]個あった", vbInformation

End Sub

'ここまで-----------------------------------------------------------------

◎質問者からの返答

ありがとうございます、上書きの方を利用させていただきます。


3 ● ekusutasii
●0ポイント

仕事できますね。俺絶対適わない。応援してます。


4 ● x31
●15ポイント

外部のサーバーでもよければ以下はいかがでしょうか。

http://www.ahref.org/cgi/mailchu/

http://joho.boo.jp/app-e/eadd.cgi

◎質問者からの返答

ありがとうございました。

数万行の処理が難しそうです。


5 ● llusall
●500ポイント ベストアンサー

再回答ですみません。

前回ものは、結果ファイルが上書きされてしまう為、追加書き込みされるように修正しました。




Option Explicit

Const ADDR_FILE = "D:\KEKKA.TXT" '抽出たアドレスを入れるファイル名

Call Main()

Sub Main()

    Dim objArgs

    Dim i

    Dim nArgCnt

    Dim bRtn

    Dim sPath

    Dim objFS, objTXT, objTXT2, sLine

    Dim reg, Matches, mc, cnt

    Err.Clear

    'コマンドライン引数の有無チェック

    Set objArgs = WScript.Arguments

    nArgCnt = objArgs.Count

    If nArgCnt = 0 Then

        MsgBox "アイコンにファイルをドラッグ&ドロップしてください。", vbExclamation

        Exit Sub

    End If

    Set reg = New RegExp

    reg.Global = True

    reg.Pattern =  "([\w]+)([\w\.-]+)@([\w\-]+)\.([\w\.\-]*)[a-z][a-z]"

    Set objFS   = CreateObject("Scripting.FileSystemObject")

    Set objTXT2 = objFS.OpenTextFile( ADDR_FILE , 8 , True )

    'ファイル数の処理を実行

    cnt = 0

    For i = 0 To nArgCnt -1

        sPath = objArgs(i)

        Set objTXT  = objFS.OpenTextFile( sPath, 1, False )

        Do Until objTXT.AtEndOfStream

            sLine = objTXT.ReadLine

            Set Matches = reg.Execute(sLine)

            For Each mc in Matches

                objTXT2.WriteLine(mc.Value)

                cnt = cnt + 1

            Next

        Loop

        objTXT.Close

        Set objTXT  = Nothing

    Next

    objTXT2.Close

    Set objTXT2 = Nothing

    MsgBox "おしまい。[" & cnt & "]個あった", vbInformation

End Sub

◎質問者からの返答

ありがとうございます。

すごいです。理想的な処理です。

これはVBスクリプトになるのでしょうか。

なにを勉強するとこのコードを考える事ができるのでしょうか。

本当にありがとうございました。


1-5件表示/6件
4.前の5件|次5件6.
関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ