Outlook 2002 以前の個人用フォルダ ファイルおよび個人用アドレス帳のパス名を取得するスクリプト


コメントで以下のようなご要望をいただきました。


現在、OL2000からOL2007への移行プロジェクトに携わっております。
今回、OL2000に現状紐づいているファイルを取得できるスクリプトを教えて
いただければと思い投稿させていただきました。
貴サイト内にて"Outlook 個人用フォルダ ファイルのパス名を取得するスクリプト"
を拝見しましたが、OL2000環境では正常に動作いたしませんでした。
環境———————————————
OS:Win2000 Sp4
Outlook Ver. : Microsoft Outlook 2000 SR-1 (9.0.0.3821)
————————————————-
実現できれば良いなと思っていること——————
・対象のユーザーでログインし、スクリプトをたたき、現在紐づいている
 PSTファイルのフルパスの取得。
・取得した情報は%userprofile%\デスクトップ\mail_path.txtとして保存
・取得したPSTファイルのフルパスが複数ある場合は、配信先になっている
 PSTファイルに何らかのしるしをつける。
・個人用アドレス帳がある場合はそのフルパスも取得
 ない場合は個人用アドレス帳無しと記載mail_path.txtに記載
————————————————————–
以上になります。


今回は、こちらの質問に回答させていただきます。

Outlook 2002 以前では PST のパス名は以下のレジストリ値に保存されています。

    レジストリ キー: HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\プロファイル名\ランダムな 16 進数
    値の名前: 001e6700
    値の種類: REG_STRING

Outlook 2003 とは異なり、PST のパス名などは Unicode データではなく、通常の文字列 (日本語環境では Shift-JIS) で保存されています。
また、その PST が既定の配信先として設定されているかどうかは、以下のレジストリ値の最初の 1 バイトの 2 ビット目がオンであるかどうかで判別可能です。

    レジストリ キー: HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\プロファイル名\ランダムな 16 進数
    値の名前: 00033009
    値の種類: REG_STRING

これらのレジストリ キーのランダムな 16 進数を取得する方法は、Outlook 2003 と同様です。

さらに、PAB のパス名は以下のレジストリ値に保存されています。

    レジストリ キー: HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\プロファイル名\ランダムな 16 進数
    値の名前: 001e6600
    値の種類: REG_STRING

このレジストリ キーのランダムな 16 進数は以下のレジストリ値から取得可能です。

    レジストリ キー: HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\プロファイル名\9207f3e0a3b11019908b08002b2a56c2
    値の名前: 01023d01
    値の種類: REG_BINARY

以下は、既定の MAPI プロファイルで使用されている PST と PAB のパス名を取得し、%userprofile%\デスクトップ\mail_path.txtとして保存する VBScript です。既定の配信先となっている PST については、ファイル名の後に "[既定の配信先]" という文字列が付与されます。また、PAB がプロファイルに存在しない場合は、最後に「個人用アドレス帳無し」と書き込みます。

' ここをトリプルクリックでマクロ全体を選択できます。
Const HKEY_CURRENT_USER = &H80000001
Const MAPI_PROFILE_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const MAPI_SERVICES_KEY = "9207f3e0a3b11019908b08002b2a56c2"
Const PR_STORE_PROVIDERS = "01023d00"
Const PR_AB_PROVIDERS = "01023d01"
Const PR_PST_PATH = "001e6700"
Const PR_PAB_PATH = "001e6600"
Const PR_RESOURCE_FLAGS = "00033009"
Const SERVICE_DEFAULT_STORE = 2
Dim strLogFile
Dim stdRegProv
Dim strDefaultProfile
Dim strProfileKey
Dim strServicesKey
Dim arrServiceUIDs
Dim objFS
Dim objShell
Dim stmText
Dim iCount
Dim i,j
Dim strServiceKey
Dim strPSTPath
Dim strPABPath
Dim arrData
Dim bPABExists
' ログファイルを開く
Set objShell = CreateObject("WScript.Shell")
strLogFile = objShell.ExpandEnvironmentStrings("%userprofile%") & "\デスクトップ\mail_path.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set stmText = objFS.CreateTextFile(strLogFile, True)
' MAPI プロファイルのレジストリを開く
Set stdRegProv = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
stdRegProv.GetStringValue HKEY_CURRENT_USER, MAPI_PROFILE_KEY, "DefaultProfile", strDefaultProfile
strProfileKey = MAPI_PROFILE_KEY & "\" & strDefaultProfile & "\"
strServicesKey = strProfileKey & MAPI_SERVICES_KEY
' PST の取得処理
stdRegProv.GetBinaryValue HKEY_CURRENT_USER, strServicesKey, PR_STORE_PROVIDERS, arrServiceUIDs
iCount = (UBound(arrServiceUIDs)+1)/16
For i=0 To iCount-1
    strServiceKey = ""
    For j=0 To 15
        strServiceKey = strServiceKey & Right("0" & Hex(arrServiceUIDs(i*16+j)), 2)
    Next
    If stdRegProv.GetStringValue(HKEY_CURRENT_USER, strProfileKey & strServiceKey, PR_PST_PATH, strPSTPath) = 0 Then
        stdRegProv.GetBinaryValue HKEY_CURRENT_USER, strProfileKey & strServiceKey, PR_RESOURCE_FLAGS, arrData
        If (arrData(0) And SERVICE_DEFAULT_STORE) = 0 Then
            stmText.WriteLine strPSTPath
        Else
            stmText.WriteLine strPSTPath & vbTab & "[既定の配信先]"
        End If
    End If
Next
' PAB の取得処理
stdRegProv.GetBinaryValue HKEY_CURRENT_USER, strServicesKey, PR_AB_PROVIDERS, arrServiceUIDs
iCount = (UBound(arrServiceUIDs)+1)/16
bPABExists = False
For i=0 To iCount-1
    strServiceKey = ""
    For j=0 To 15
        strServiceKey = strServiceKey & Right("0" & Hex(arrServiceUIDs(i*16+j)), 2)
    Next
    If stdRegProv.GetStringValue(HKEY_CURRENT_USER, strProfileKey & strServiceKey, PR_PAB_PATH, strPABPath) = 0 Then
        stmText.WriteLine strPABPath
        bPABExists =  True
    End If
Next
If Not bPABExists Then
    stmText.WriteLine "個人用アドレス帳無し"
End If
' 後処理
stmText.Close
'
Set stdRegProv = Nothing
Set stmText = Nothing
Set objFS = Nothing
Set objShell = Nothing

広告

Outlook 2002 以前の個人用フォルダ ファイルおよび個人用アドレス帳のパス名を取得するスクリプト」への2件のフィードバック

  1. Millefeuille様
    質問させていただいた、うえじーと申します。
    ご提示いただいたスクリプトですが、私の要望を全て満たしており
    大変たすかりました。ありがとうございました。
    また、御礼遅れまして申し訳ございませんでした。
     
    今後とも貴サイト楽しみにしております。
     
    それでは失礼致します。

  2. Millefeuille様
    質問させていただいた、うえじーと申します。
    ご提示いただいたスクリプトですが、私の要望を全て満たしており
    大変たすかりました。ありがとうございました。
    また、御礼遅れまして申し訳ございませんでした。
     
    今後とも貴サイト楽しみにしております。
     
    それでは失礼致します。

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中