OEでの重複メール削除

質問

Win98seでOE6を使ってますが、開封済みの重複メールが、沢山あるんです。

重複メールとは、全く同じメールが２つずつあり、１００ぐらいあるんです。

１つ１つ削除していたら、大変です。
僕が知ってるメーラーでも、BeckyやShurikenには、「重複メールの削除」というコマンドがあります。

OEでも、片方が未開封なら、表示＞現在のビュー＞開封済みのメッセージを表示しない、で、削除できるんですが、重複メールの両方とも開封済みなんです。

助けてください。お願いします。

回答No.2

ittochan · ベストアンサー

メモ帳を開いて
↓の文章を貼り付けて
ittochan.vbs
ってこんな感じで拡張子がvbsのファイルで
保存してください。

Set WshShell = CreateObject("WScript.Shell")

Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
IE.Visible = 1
IE.Navigate "about:blank"
IE.Width=100
IE.Height = 100
IE.Left = 0
IE.Top = 0
Do While IE.Busy
Wscript.Sleep 10
Loop

intBtn = WshShell.Popup("重複メールの削除を開始します" & vbcr & vbcr _
& "OutlookExpressを開いて" & vbcr _
& "重複メールのあるフォルダを開いておいてください" & vbcr & vbcr _
& "左上に小さいIEが表示されますので強制終了させるときは、このIEを閉じてください" & vbcr & vbcr _
& "準備が出来たら「OK」をクリックしてください" ,0,"by ittochan",49)
if intBtn = 2 then
IE.Quit
WScript.Quit
end if

UserId = WshShell.RegRead("HKCU\Identities\Last User ID")
key = "HKCU\Identities\" & UserId & "\Software\Microsoft\Outlook Express\5.0\Mail\"
Check_Mail_on_Startup = WshShell.RegRead(key & "Check Mail on Startup")
Poll_For_Mail = WshShell.RegRead(key & "Poll For Mail")
ShowHybridView = WshShell.RegRead(key & "ShowHybridView")
if (Poll_For_Mail<>-1) or (ShowHybridView=1) or (Check_Mail_on_Startup=1) then
msg1=""
if Check_Mail_on_Startup=1 then
msg1= "起動時に新着メッセージをチェックする」"
end if
msg2=""
if Poll_For_Mail<>-1 then
msg2 = "「新着メッセージをチェックする」"
end if
msg3=""
if ShowHybridView=1 then
msg3 = "「プレビューウィンドウを表示する」"
end if
msg4 = vbcr & "のチェックを外してOutlook Expressを起動します"
intBtn = WshShell.Popup(msg1 & msg2 & msg3 & msg4)
if intBtn = 2 then
IE.Quit
WScript.Quit
end if
end if
WshShell.RegWrite key & "Mail\Check Mail on Startup",0,"REG_DWORD"
WshShell.RegWrite key & "Mail\Poll For Mail",-1,"REG_DWORD"
WshShell.RegWrite key & "Mail\ShowHybridView",(ShowHybridView * -1)+1,"REG_DWORD"

mailCnt = InputBox("このフォルダのメール総数を入力してください","ittochan",0)

if mailCnt = 0 then
IE.Quit
WScript.Quit
end if

'クリップボードの内容をクリア
IE.Document.parentWindow.clipboardData.setdata "text",""

if WshShell.AppActivate("- Outlook Express")=false then
WScript.Echo "Outlook Expressのアクティブ化に失敗しました"
errQuit()
end if

'フォルダが選択状態か？
delayedSendKeys "+{f10}"
delayedSendKeys "m"
WScript.Sleep 500
Do While WshShell.AppActivate("フォルダ名の変更")=false
delayedSendKeys "{esc}"
delayedSendKeys "{tab}"
delayedSendKeys "+{f10}"
delayedSendKeys "m"
WScript.Sleep 500
Loop

delayedSendKeys "{esc}"

'並び替え
delayedSendKeys "%vb"
delayedSendKeys "{DOWN 2}"
delayedSendKeys "{enter}"
delayedSendKeys "%vb"
delayedSendKeys "a"

delayedSendKeys "{tab}"
WScript.Sleep 500

for i=0 to mailCnt
WshShell.SendKeys "{DOWN}"
next
WScript.Sleep 5000

'delayedSendKeys "{tab}"
'
'WScript.Sleep 2000

'本文のコピー
str1Main = copy()
WScript.Sleep 500

for i=0 to mailCnt-2

'次のメッセージへ
delayedSendKeys "^,"
WScript.Sleep 100
' WScript.Sleep 2000

'本文のコピー
str2Main = copy()

WScript.Sleep 100

if str1Main = str2Main then

'削除
delayedSendKeys "^d"
WScript.Sleep 1000
' WScript.Sleep 100

end if
str1Main = str2Main
next
WScript.Echo "終了しました"
oe_quit()
IE.Quit
WScript.Quit

Sub delayedSendKeys(str)
WScript.Sleep 200
WshShell.SendKeys str
End Sub
sub oe_quit()
WshShell.AppActivate(objOE.ProcessID)
delayedSendKeys "%{F4}"
option_rev()
end sub
Sub errQuit()
oe_quit()
IE.Quit
WScript.Quit
End Sub

'本文のコピー
Function copy()
delayedSendKeys "%{enter}"
delayedSendKeys "{right}"
delayedSendKeys "{tab}"
delayedSendKeys "+{f10}"
delayedSendKeys "a"
delayedSendKeys "+{f10}"
delayedSendKeys "c"
delayedSendKeys "{esc}"
copy = IE.Document.parentWindow.clipboardData.getdata("text")
End Function
Function copy1()
delayedSendKeys "%{enter}"
delayedSendKeys "{right}"
delayedSendKeys "%m"
delayedSendKeys "%m"
delayedSendKeys "^a"
delayedSendKeys "^c"
delayedSendKeys "%{F4}"
delayedSendKeys "{esc}"
copy = IE.Document.parentWindow.clipboardData.getdata("text")
End Function
Function copy2()
delayedSendKeys "^a"
delayedSendKeys "^c"
copy = IE.Document.parentWindow.clipboardData.getdata("text")
End Function

Sub IE_onQuit()
WScript.Echo "強制終了しました"
WshShell.AppActivate(objOE.ProcessID)
delayedSendKeys "%{F4}"
option_rev()
WScript.Quit
End Sub
sub option_rev()
do while WshShell.RegRead( key & "Running")=1
loop
WshShell.RegWrite key & "Mail\Check Mail on Startup",Check_Mail_on_Startup,"REG_DWORD"
WshShell.RegWrite key & "Mail\Poll For Mail",Poll_For_Mail,"REG_DWORD"
WshShell.RegWrite key & "Mail\ShowHybridView",ShowHybridView,"REG_DWORD"
end sub

テストとして重複メールがあるフォルダの内容を
新しいフォルダにコピーしておいてください

OutlookExpressを閉じて
今保存したファイルをダブルクリックして
メッセージに従ってみてください。

お礼

ご丁寧な回答をどうも有り難うございました。

腕まくりして、挑戦してみます。

回答No.1

ittochan

暇つぶしに作ったスクリプト(vbs)があるんですが
使ってみますか？
↓こんな感じのものです。

参考URL：

http://www.okweb.ne.jp/kotaeru.php3?q=355424

お礼

どうも有り難うございます。

しかし素人なので、ちんぷんかんぷんです。

まともじゃ、できないということでしょうか？