Dragon-Ark

vbscriptにてOutlook Exressのメールファイル(.dbx)の一覧とサイズを出力する例です。

Option Explicit
'On Error Resume Next

'#######################################################
'#                 Global-Configration                 #
'#######################################################

  Const OpenTextFileForReading     = 1
  Const OpenTextFileForWriting     = 2
  Const OpenTextFileForAppending   = 8

  Const HKEY_CURRENT_USER   = &H80000001

'*************************
'    Call Main Program
'*************************
  Main()

'*************************
'   Start Main Program
'*************************

Sub Main()

'#######################################################
'#                 Local-Configration                  #
'#######################################################

  Dim OBJ_WshShell    'WSH Shell Object
  Dim OBJ_FSO         'File System Object
  Dim OBJ_Folders     'Folder Object

  Dim COL_Folders     'Collection Object

  Dim STR_FileName    'String Object
  Dim STR_StoreOwner  'String Object
  Dim STR_StorePath   'String Object
  Dim STR_LogFolder   'String Object
  Dim STR_LogFile     'String Object
  Dim STR_Temp        'String Object
  Dim i

  Set OBJ_WshShell = WScript.CreateObject("WScript.Shell")
  Set OBJ_FSO      = WScript.CreateObject("Scripting.FileSystemObject")

'【Get Mail Store Owner & Mail Store Path】
  STR_StoreOwner = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\Last User ID")
  If Err.Number <> 0 Then

    STR_Work = MsgBox("処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。" & vbCrLf & "Error Code: RegRead Error-001" ,vbOkOnly + vbCritical,"エラーが発生しました")
    Err.Clear
    Set OBJ_FSO = Nothing
    WScript.Quit 1

  End If

  STR_StorePath  = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\" & STR_StoreOwner & "\Software\Microsoft\Outlook Express\5.0\Store root")
  If Err.Number <> 0 Then

    STR_Work = MsgBox("処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。" & vbCrLf & "Error Code: RegRead Error-002" ,vbOkOnly + vbCritical,"エラーが発生しました")
    Err.Clear
    Set OBJ_FSO = Nothing
    WScript.Quit 1

  End If

  WScript.Echo "No,ファイル名,ファイルサイズ(MB)"

'【Get MailBox Folder & File-Size】
  Set OBJ_Folders = OBJ_FSO.GetFolder(STR_StorePath)
  Set COL_Folders = OBJ_Folders.Files
  i = 1

  For Each STR_FileName In COL_Folders

    If LCase(Right(STR_FileName,4)) = ".dbx" Then

      WScript.Echo i & "," & STR_FileName & "," & Round(STR_FileName.Size / 1000000,1)
      i = i + 1

    End If

  Next

End Sub