メモ帳を開いて
↓の文章を貼り付けて
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を閉じて
今保存したファイルをダブルクリックして
メッセージに従ってみてください。
お礼
ご丁寧な回答をどうも有り難うございました。 腕まくりして、挑戦してみます。