「System R」の検索結果
「WSH」
から
次の単語がハイライトされています :
MDBCompactAndBackup "ソースのMDBファイルのパス" "バックアップフォルダのパス"
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count = 0 Then
WScript.Quit
End If
Dim SourceDBName
SourceDBName = WScript.Arguments(0)
Dim BackupFolderName
If WScript.Arguments.Count = 2 Then
BackupFolderName = WScript.Arguments(1)
Else
BackupFolderName = fso.GetParentFolderName(SourceDBName)
End If
'バックアップフォルダーがなければ処理中止
If fso.FolderExists(BackupFolderName) = False Then
WScript.Quit
End If
Dim SourceLFName
SourceLFName = fso.BuildPath(fso.GetParentFolderName(SourceDBName),fso.GetBaseName(SourceDBName) & ".ldb")
'ロックファイルがあったら処理中止
If fso.FileExists(SourceLFName) Then
WScript.Quit
End If
Dim TempDBName
TempDBName = fso.BuildPath(fso.GetParentFolderName(SourceDBName),fso.GetBaseName(SourceDBName) & ".compact.tmp")
'一時ファイルがあったら削除
If fso.FileExists(TempDBName) Then
fso.DeleteFile TempDBName
End If
'最適化
Dim Jet
Set Jet = WScript.CreateObject("JRO.JetEngine")
Jet.CompactDatabase ";Data Source=" & SourceDBName, ";Data Source=" & TempDBName
'圧縮
Dim f
Set f = fso.GetFile(SourceDBName)
Dim FileName
FileName=f.Name
Dim ZipFileName
ZipFileName = fso.BuildPath(BackupFolderName,GetYYYYMMDDHHNNSS(f.DateLastModified) & FileName & ".zip")
If fso.FileExists(ZipFileName) = False Then
Dim Shell
Set Shell=CreateObject("Shell.Application")
Set SourceFolder = Shell.NameSpace(fso.GetParentFolderName(SourceDBName))
Set SourceFolderItem = SourceFolder.ParseName(FileName)
fso.CreateTextFile(ZipFileName,False).Write "PK" & Chr(5) & Chr(6) & String(18,0)
Dim ZipFolder
Set ZipFolder = Shell.NameSpace(ZipFileName)
ZipFolder.CopyHere SourceFolderItem
While ZipFolder.Items().Count = 0
WScript.Sleep 100
Wend
End If
'リネーム
f.delete
Set f = Nothing
fso.MoveFile TempDBName,SourceDBName
Function GetYYYYMMDDHHNNSS(dt)
GetYYYYMMDDHHNNSS = RIGHT("0000" & Year(dt),4) & RIGHT("00" & Month(dt),2) & RIGHT("00" & Day(dt),2) & RIGHT("00" & Hour(dt),2) & RIGHT("00" & Minute(dt),2) & RIGHT("00" & Second(dt),2)
End Function
SourceFileName = "圧縮したいファイルのパス"
ZipFileName = "作成したい圧縮ファイルのパス"
Set fso=CreateObject("Scripting.FileSystemObject")
Set Shell=CreateObject("Shell.Application")
FileName=fso.GetFileName(SourceFileName)
Set SourceFolder = Shell.NameSpace(fso.GetParentFolderName(SourceFileName))
Set SourceFolderItem = SourceFolder.ParseName(FileName)
fso.CreateTextFile(ZipFileName,False).Write "PK" & Chr(5) & Chr(6) & String(18,0)
Set ZipFolder =Shell.NameSpace(ZipFileName)
ZipFolder.CopyHere SourceFolderItem
'コピーが非同期のようでこのループを入れたほうがよいようです。
While ZipFolder.Items().Count = 0
WScript.Sleep 100
Wend
MsgBox "OK!"
クラスの生成時刻 | 処理毎の一意キー | 処理毎のカウンタ | ステップ実行時刻 | 実行PC名 | 実行ユーザー名 | 整数値 | メッセージ |
Option Explicit
'インクルード
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Execute fso.OpenTextFile("Hoge\Moge\LogRecorder.vbs", 1, False).ReadAll()
'インスタンスの生成
Dim myLog
Set myLog = New LogRecorder
myLog.SetLogFile("ログファイルのパス")
myLog.Write 1000000000000,"TE" & """" & "ST"""
myLog.Write 1.1,"TE STTAB"
myLog.Write "xdar","TES" & vbCrLf & "Tvbcrlf"
Class LogRecorder
'定型書式でログを記録するクラスです。異なる処理や異なるPCで行ったログファイルを最終的に集積できるように
'GUIDで一意キーを生成しています。前3列でソートすれば、完全に実行順に処理が並びます。
'ログファイルのパスをセットしないときはスクリプトの実行フォルダにLogRecorder.txtを生成します。
'
'ログファイルはTab区切りで、記録項目は下記の通りです。
'クラスの生成時刻/処理毎の一意キー/処理毎のカウンタ/ステップ実行時刻/実行PC名/実行ユーザー名/Number/Description
'
Private GUID
Private fso
Private net
Private logfile
Private counter
Private startdt
Private openstate '0-開いていない/1-開けた/2-開けなかった
'コンストラクタ
Private Sub Class_Initialize()
Set fso = CreateObject("Scripting.FileSystemObject")
Set net = WScript.CreateObject("WScript.Network")
GUID = MID(CreateObject("Scriptlet.Typelib").GUID,2,36)
counter = 0
startdt = Now()
openstate = 0
End Sub
Sub SetLogFile(Value)
'ログファイルが開いていたらクローズ
If TypeName(logfile) = "TextStream" Then
logfile.Close
End If
On Error Resume Next
Set logfile = fso.OpenTextFile(Value,8,True)
If Err.Number = 0 Then
openstate = 1
Else
MsgBox Err.Number & vbCrLf & Err.Description
openstate = 2
End If
On Error Goto 0
End Sub
Sub Write(number,description)
If openstate = 0 Then
SetLogFile(fso.GetParentFolderName(WScript.ScriptFullName) & "\LogRecorder.txt")
End If
If openstate = 1 Then
If IsNumeric(number) Then
number = Int(number)
Else
number = 0
End If
description = Replace(description,vbCrLf,vbLf)
description = """" & Replace(description,"""","""""") & """"
logfile.WriteLine startdt _
& vbTab & GUID _
& vbTab & counter _
& vbTab & Now() _
& vbTab & net.ComputerName _
& vbTab & net.UserName _
& vbTab & number _
& vbTab & description
counter = counter + 1
End If
End Sub
' デストラクタ
Private Sub Class_Terminate()
'ログファイルが開いていたらクローズ
If TypeName(logfile) = "TextStream" Then
logfile.Close
End If
End Sub
End Class
'こんな感じで定義して
Class myClass
'コンストラクタ
Private Sub Class_Initialize()
End Sub
' デストラクタ
Private Sub Class_Terminate()
End Sub
End Class
'こんな感じで呼び出し
Set myInstance = New myClass
Set fso = CreateObject("Scripting.FileSystemObject")
Execute fso.OpenTextFile("includeしたいスクリプトのパス", 1, False).ReadAll()
GUID = CreateObject("Scriptlet.Typelib").GUID
GUID = MID(GUID,2,36)
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.OpenTextFile(".\ApplicationList.txt", 8, True)
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each strSubKey in arrSubkeys
strValueName = "DisplayName"
strSubPath = strKeyPath & "\" & strSubKey
objRegistry.GetStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
If Not IsNull(strValue) Then
objOutput.WriteLine strValue
End If
Next
objOutput.Close