Dragon-Ark

[`livedoor` not found]

Tweet

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

[vb]
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

[/vb]