はじめに
私は基本的にBeckyを使っていますが、O365を使うようになり、今までのデータをOutlookに移す必要が出てきました。調べてみると、結構大変なんですよね。
EMLファイルは直接Outlookに登録できないですし。(正確には登録できるけど、プレビューできない。)
それを有償で変換するソフトも沢山出ているのですが、疑い深い私はそれを使うのもって感じだったので、自分で作れないか調べてみました。
Google先生で調べてみると、VBSで作っているものが出てきます。
けどこの方法は、1件ずつ開いてインポートするので、かなり遅い・・・・。
海外まで検索すると、もうちょっと高速で動く方法が載っていたので、それを改造してみたので、今回皆さんに公開したいと思います。
前準備
「Outlook Redemption」のDeveloper versionをダウンロード
ダウンロードしたファイルを実行して、インストールします。
BeckyからのEMLへの一括変換は、「CircleBecky」のプラグインが便利です。
プログラム
下記のプログラムをコピペして、適当な名前(例:imporrt-eml.vbs)にして保存します。
Dim objShell : Set objShell = CreateObject("Shell.Application")
Dim FSO : Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim objFolder : Set objFolder = objShell.BrowseForFolder(0, "Select the folder", 0)
Dim oLog, fn
Set wFolder = FSO.GetFolder(objFolder.Items.Item.Path)
Set oOutlook = CreateObject("Outlook.Application")
' Log Setting
fn = FSO.getParentFolderName(WScript.ScriptFullName) & "\" & _
FSO.GetBaseName(WScript.ScriptFullName) & "_" & _
Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2) & ".log"
If FSO.FileExists(fn) = False then
Set oLog = FSO.CreateTextFile(fn)
Else
Set oLog = FSO.OpenTextFile(fn, 8, True)
End If
If (NOT objFolder is nothing) Then
Dim oBaseFolder : Set oBaseFolder = oOutlook.Session.PickFolder
If NOT oBaseFolder Is Nothing Then
oLog.WriteLine(Now() & " Start...")
LoopFolder wFolder, oBaseFolder
oLog.WriteLine(Now() & " Finish...")
MsgBox "Import completed.", 64, "Import EML"
Else
MsgBox "Import canceled.", 64, "Import EML"
End If
Set Folder = Nothing
Else
MsgBox "Import canceled.", 64, "Import EML"
End If
oLog.Close
Set oLog = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Sub LoopFolder(in_wFolder, in_oFolder)
Dim wSubFolder
Dim i : i = 0
Dim oFolder : Set oFolder = in_oFolder.Folders.Add(in_wFolder.Name)
For Each file In in_wFolder.files
If LCase(Right(file.Name,4)) = ".eml" Then
OpenEml oFolder,file
i = i + 1
End If
Next
For Each wSubFolder In in_wFolder.SubFolders
LoopFolder wSubFolder, oFolder
Next
oLog.WriteLine(Now() & " " & in_wFolder.Name & ":" & i)
End Sub
Sub OpenEml( Folder, file )
Set objPost = Folder.Items.Add(6)
Set objSafePost = CreateObject("Redemption.SafePostItem")
objSafePost.Item = objPost
objSafePost.Import file, 1024
objSafePost.MessageClass = "IPM.Note"
Set utils = CreateObject("Redemption.MAPIUtils")
PrIconIndex = &H10800003
utils.HrSetOneProp objSafePost, PrIconIndex, 256, true 'Also saves the message
i = i + 1
End Sub
使い方
1.まずインポート元のEMLファイルが格納されているフォルダを指定します。
2.Outlook側でどのフォルダにインポートするかを指定します。
3.「Outlook Redemption」のライセンスの同意画面が出るので、「I Agree」を選択します。
あとは、全階層を見て自動的にインポートされますので、ゆっくり待ちましょう。
VBSと同じ階層に、簡単なログファイルが吐き出されますので、件数など見て、正常にインポートされているか確認してみてください。
まとめ
いかがだったでしょうか?これで少しは移行も簡単になったとは思います。
あまり需要の無い情報かもしれませんが、良かったら使ってみてください。
コメント