Outlook 個人用フォルダ ファイルのパス名を取得するスクリプト


先日、コメントで以下のような質問を頂きました。


この度、社内のPC約500台を新PCにリプレースすることになったのですが、現在各社員が使用しているOutlook2003の設定情報(個人用アドレス帳(*.pab)、接続されている個人用フォルダ(*.pst))のファイル名をVBAで取得できないかと悩んでいます。
リプレース前作業にあたり、各社員にプロパティのファイル名を転記してもらうのは何とか避けたい(PCに詳しくない社員も半数程度存在します。)と思っています。
個人用アドレス帳は、"MAPI"名前空間の"AddressLists"とレジストリ(Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook)下のキー"001e3001"と"001e6600"の値を検索することでファイル名が得られたのですが、個人用フォルダ情報はレジストリには保有されていないようです。ファイル名を保有しているオブジェクトを、お教え頂ければ幸いです。
Outlook個人用フォルダのプロパティ→詳細でファイル名が表示されるため、どれかのオブジェクトがファイル名を保持していると考えているのですが・・・


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

残念ながら、Outlook 2003 では Outlook Object Model から個人用フォルダ ファイル (以下、PST) のパス名を取得することはできませんが、レジストリからパス名を取得することが可能です。
Outlook 2003 以降では、PST のパス名は以下のレジストリ値に保存されています。

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

そして、バイナリのデータを Unicode 文字列に変換することで、PST のパス名を取得することが可能です。
ただし、このデータを取得するには、まずランダムな 16 進数を取得する必要があります。ランダムな 16 進数はメッセージ ストア プロバイダの ID であり、この情報は以下のレジストリ値に保存されています。

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

このデータにはプロファイルに含まれるメッセージ ストア プロバイダの ID が 16 バイトずつ連続して格納されています。これを文字列に変換して上記のランダムな 16 進数に当てはめることにより、PST のパス名を取得できるようになるというわけです。
以下は、既定の MAPI プロファイルで使用されている PST のパス名を取得して表示する VBScript です。

' ここをトリプルクリックでマクロ全体を選択できます。
    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_PST_PATH = "001f6700"
    Const LOG_FILE = "C:\pstpath.txt"
    Dim stdRegProv
    Dim strDefaultProfile
    Dim strProfileKey
    Dim strServicesKey
    Dim arrStoreUIDs
    Dim objFS
    Dim stmText
    Dim iCount
    Dim i,j
    Dim strServiceKey
    Dim strPSTPath
    Dim arrData 
'
    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
    stdRegProv.GetBinaryValue HKEY_CURRENT_USER, strServicesKey, PR_STORE_PROVIDERS, arrStoreUIDs 
'
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set stmText = objFS.CreateTextFile(LOG_FILE,True)
'
    iCount = (UBound(arrStoreUIDs)+1)/16
    For i=0 To iCount-1
        strServiceKey = ""
        For j=0 To 15
            strServiceKey = strServiceKey & Right("0" & Hex(arrStoreUIDs(i*16+j)), 2)
        Next
        stdRegProv.GetBinaryValue HKEY_CURRENT_USER, strProfileKey & strServiceKey, PR_PST_PATH, arrData
        If Not IsNull(arrData) Then
            stmText.WriteLine BinToUnicode(arrData)
        End If
    Next
    stmText.Close 
'
    Set stdRegProv = Nothing
    Set stmText = Nothing
    Set objFS = Nothing 
'
    Function BinToUnicode( arrData )
        Dim strUnicode
        Dim i
        strUnicode = ""
        For i = 0 To UBound(arrData) Step 2
            strUnicode = strUnicode & ChrW( arrData(i) + arrData(i+1) * &h100 )
        Next
        BinToUnicode = Replace( strUnicode, Chr(0), "" )
    End Function

このスクリプトを実行すると、LOG_FILE で指定したテキスト ファイルに PST のパス名の一覧が保存されます。

また、Outlook 2007 では Outlook Object Model の Store オブジェクトの FilePath プロパティにより、PST のパス名が取得できるようになりました。
以下は、Outlook 2007 で上記と同様の処理を行う VBScript です。

' ここをトリプルクリックでマクロ全体を選択できます。
    Const LOG_FILE = "C:\pstpath.txt"
    Dim myOlk
    Dim mySession
    Dim objFS
    Dim stmText
    Dim objStore 
'
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set stmText = objFS.CreateTextFile(LOG_FILE,True)
    Set myOlk = CreateObject("Outlook.Application")
    Set mySession = myOlk.GetNamespace("MAPI")
    mySession.Logon
'
    For Each objStore In mySession.Stores
        If objStore.ExchangeStoreType = 3 And objStore.IsDataFileStore Then
            stmText.WriteLine objStore.FilePath
        End If
    Next 
'
    stmText.Close
    Set stmText = Nothing
    Set myOlk = Nothing

広告

Outlook 個人用フォルダ ファイルのパス名を取得するスクリプト」への1件のフィードバック

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中