Outlook の個人用フォルダのサイズをテキスト ファイルに出力するスクリプト


コメントにて以下のご要望をいただきました。


いつもお世話になっております。

こちらの記事で紹介している、「Outlook の個人用フォルダのサイズをチェックするスクリプト 」を利用しようと考えているのですが、Outlookのバージョンが混在しており、しきい値の設定に難儀しております。

   取り敢えず、ユーザー展開する前に手前でPSTの利用状況を把握しておきたく、「MSGBOX」に表示される内容をファイル(TXTやCSV)に出力する事は可能でしょうか?(※MSGBOXの表示は不要です)

当方、VBA等の知識に乏しく、勝手なお願いでは御座いますが、
ご協力頂けると幸甚です。宜しくお願い致します。



PST のファイル パスとサイズをテキスト ファイルに保存するスクリプトを作りました。
Outlook のバージョンが混在しているという状況から、社内の複数の PC で処理するというようなことを想定し、保存ファイル名に %USERNAME% のような環境変数を使用できるようにしてみました。
スクリプトは以下の通りです。

' ここをトリプルクリックでスクリプト全体を選択できます。
Option Explicit
Const REPORT_FILE = "\\server\share\pstreport-%USERNAME%.txt"
Const HKEY_LOCAL_MACHINE = &H80000002
Const CLIENTS_MAIL_OUTLOOK_VER = "SOFTWARE\Clients\Mail\Microsoft Outlook\Envelope\CurVer"
Const HKEY_CURRENT_USER = &H80000001
Const MAPI_PROFILE_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const MAPI_SERVICES_KEY = "9207f3e0a3b11019908b08002b2a56c2"
'
Dim objReg
Dim objFSO
Dim objWSH
Dim strCurVer
Dim strKey
Dim strOutlookKey
Dim strProfilesKey
Dim strDefaultProfile
Dim strProfileKey
Dim strServicesKey
Dim abyStoreUIDs
Dim abyAddrBookUIDs
Dim iCount
Dim i,j
Dim strServiceKey
Dim strPSTPath
Dim abyData
Dim objPSTFile
Dim stmReport
'
' レジストリにアクセスするための WMI の StdRegProv オブジェクトを取得します。
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
' ファイル情報にアクセスするための FileSystemObject オブジェクトを取得します。
Set objFSO = CreateObject("Scripting.FileSystemObject")
' 環境変数を展開するための WshShell オブジェクトを取得します。
Set objWSH = CreateObject("WScript.Shell")
' Outlook のバージョンの確認を行います。
objReg.GetStringValue HKEY_LOCAL_MACHINE, CLIENTS_MAIL_OUTLOOK_VER, "", strCurVer
If Instr(strCurVer, "12") > 0 Or Instr(strCurVer,"14") > 0 Then
    strProfilesKey = MAPI_PROFILE_KEY
    ' 既定の MAPI プロファイルの名前を取得します。
    objReg.GetStringValue HKEY_CURRENT_USER, strProfilesKey, "DefaultProfile", strDefaultProfile
ElseIf Instr(strCurVer, "15") > 0 Or Instr(strCurVer, "16") > 0 Then
    strOutlookKey = "Software\Microsoft\Office\" & Right(strCurVer,2) & ".0\Outlook"
    ' 既定の MAPI プロファイルの名前を取得します。
    objReg.GetStringValue HKEY_CURRENT_USER, strOutlookKey, "DefaultProfile", strDefaultProfile
    strProfilesKey = strOutlookKey & "\Profiles"
End If
' プロファイルの名前からキーの文字列を生成します。
strProfileKey = strProfilesKey & "\" & strDefaultProfile & "\"
strServicesKey = strProfileKey & MAPI_SERVICES_KEY
' メッセージ ストア プロバイダの ID の一覧を取得します。
objReg.GetBinaryValue HKEY_CURRENT_USER, strServicesKey, "01023d00", abyStoreUIDs
' PST のファイルサイズを出力するログ ファイルを作成します。
Set stmReport = objFSO.CreateTextFile(objWSH.ExpandEnvironmentStrings(REPORT_FILE))
' メッセージ ストア プロバイダの ID ごとに処理します。
iCount = (UBound(abyStoreUIDs)+1)/16
For i=0 To iCount-1
    strServiceKey = ""
     ' 16 バイトのバイナリ データを文字列に変換します。
    For j=0 To 15
        strServiceKey = strServiceKey & Right("0" & Hex(abyStoreUIDs(i*16+j)), 2)
    Next
    ' Outlook 2002 の個人用フォルダのパスを取得します。
    objReg.GetStringValue HKEY_CURRENT_USER, strProfileKey & strServiceKey, "001e6700", strPSTPath
    If IsNull(strPSTPath) Then
        ' Outlook 2003 の個人用フォルダのパスを取得します。
        objReg.GetBinaryValue HKEY_CURRENT_USER, strProfileKey & strServiceKey, "001f6700", abyData
        If Not IsNull(abyData) Then
            ' 取得できた場合にはバイナリデータを文字列に変換します。
            strPSTPath = BinaryToUnicodeString( abyData )
        End If
    End If
    If Not IsNull(strPSTPath) Then
        ' PST ファイルのサイズをログ ファイルに出力します。
        If objFSO.FileExists(strPSTPath) Then
            Set objPSTFile = objFSO.GetFile(strPSTPath)
            stmReport.WriteLine objPSTFile.Path & ": " & objPSTFile.Size & " バイト"
        End If
    End If
Next
stmReport.Close
'
'
'    バイナリ データを Unicode 文字列に変換する関数です。
'
Function BinaryToUnicodeString( abyData )
    Dim strUnicode
    Dim i
    strUnicode = ""
    ' 2 バイトごとに Unicode 文字に変換します。
    ' 最初のバイトが下位バイト、次のバイトが上位バイトになります。
    For i = 0 To UBound(abyData) Step 2
        strUnicode = strUnicode & ChrW( abyData(i) + abyData(i+1) * &h100 )
    Next
    ' 文字列の中に NULL がある場合は取り除きます。
    BinaryToUnicodeString = Replace( strUnicode, Chr(0), "" )
End Function

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中