Option Explicit
'#######################################################
'# Global-Configration #
'#######################################################
Const OpenTextFileForReading = 1
Const OpenTextFileForWriting = 2
Const OpenTextFileForAppending = 8
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'*************************
' 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 OBJ_Args 'Argument Object
Dim COL_Folders 'Collection Object
Dim STR_FileName 'String Object
Dim STR_StoreOwner 'String Object
Dim STR_RulePath '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")
Set OBJ_Args = WScript.Arguments
'引数チェック
If OBJ_Args.Count = 1 Then
STR_FileName = OBJ_Args(0)
If Right(LCase(STR_FileName), 4) = ".reg" Then
Else
STR_FileName = STR_FileName & ".reg"
End If
If OBJ_FSO.FileExists(STR_FileName) Then
WScript.Echo "エラー:出力先に同名のファイルが存在します。処理を続行出来ません。"
WScript.Quit 1
End If
Else
WScript.Echo "エラー:引数の数が不正です。処理を続行出来ません。プログラムを中止します。"
WScript.Quit 1
End If
'【Get Mail Store Owner & Mail Store Path】
STR_StoreOwner = OBJ_WshShell.RegRead("HKEY_CURRENT_USER\Identities\Last User ID")
If Err.Number <> 0 Then
WScript.Echo "エラー:処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。"
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
STR_RulePath = """HKEY_CURRENT_USER" & "\Identities\" & STR_StoreOwner & "\Software\Microsoft\Outlook Express\5.0\Rules"""
If Err.Number <> 0 Then
WScript.Echo "エラー:処理実行中にエラーが発生しました。処理を続行出来ません。プログラムを中止します。"
Err.Clear
Set OBJ_FSO = Nothing
WScript.Quit 1
End If
'レジストリのExport
OBJ_WshShell.Run "reg.exe export " & STR_RulePath & " " & STR_FileName, 0, True
If Err.Number = 0 Then
WScript.Echo "レジストリのバックアップは正常に完了しました。出力したファイルは " & STR_FileName & " です。"
WScript.Quit 0
Else
WScript.Echo "エラー:レジストリのバックアップに失敗しました。"
WScript.Quit 1
End If
End Sub
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
