Private Sub frmMDB_Load(ByVal sender
AsSystem.Object,ByVal e As System.EventArgs) Handles MyBase.Load
Const cnsDB_file As String = "F: est.mdb" ''原本DBのパス
Const cndDB_clean As String = "F:index.mdb"
Dim strCopydb As String ''コピー用DBのパス
Dim JRO As New JRO.JetEngine
Dim strBe_sysdate AsString ''ファイル名生成用日付取得(ex:2006/09/01)
Dim strAF_sysdate AsString ''ファイル名日付変換後(ex:20060901)
Dim i As Integer ''ループカウンタ
Dim s(10) As String ''日付の一文字ずつ抽出用
Dim oldDB As String
Dim newDB As String
Try
FileOpen(1, cnsDB_file,OpenMode.Input) ''ファイルにアクセスされているかチェックする
FileClose(1)
strBe_sysdate = Today
For i = 1 ToLen(strBe_sysdate)''コピーファイル名の生成(ex:20060901.mdb)
If Mid(strBe_sysdate, i, 1) <> "/" Then
s(i - 1) = Mid(strBe_sysdate, i, 1)
strAF_sysdate = strAF_sysdate & s(i - 1)
End If
Next
Catch ex As Exception
''******************************************************************
''SetEventLog(ex.Message) イベントログへの書き込みロジック(エラー)
''******************************************************************
Exit Sub
End Try
Try
strCopydb = "F:" & strAF_sysdate & ".mdb"
''ファイルをコピーする
Microsoft.VisualBasic.FileSystem.FileCopy(cnsDB_file,strCopydb)
oldDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&cnsDB_file & ";Jet OLEDB:Database Password=FDMD;"
newDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= "&cndDB_clean & ";Jet OLEDB:Database Password=FDMD;"
JRO.CompactDatabase(oldDB, newDB) ''DB最適化処理
''バックアップ用に作成したコピーファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(strCopydb)
''インデックス前のファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(cnsDB_file)
Microsoft.VisualBasic.FileSystem.Rename(cndDB_clean,cnsDB_file)
''******************************************************************
''SetEventLog("正常終了") イベントログへの書き込みロジック(正常終了)
''******************************************************************
Catch ex As Exception
''コピーしたファイルを元に戻す
Microsoft.VisualBasic.FileSystem.FileCopy(strCopydb,cnsDB_file)
''コピーしたファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(strCopydb)
''******************************************************************
''SetEventLog(ex.Message) イベントログへの書き込みロジック(エラー)
''******************************************************************
Exit Sub
Finally
End Try
End Sub
Const cnsDB_file As String = "F: est.mdb" ''原本DBのパス
Const cndDB_clean As String = "F:index.mdb"
Dim strCopydb As String ''コピー用DBのパス
Dim JRO As New JRO.JetEngine
Dim strBe_sysdate AsString ''ファイル名生成用日付取得(ex:2006/09/01)
Dim strAF_sysdate AsString ''ファイル名日付変換後(ex:20060901)
Dim i As Integer ''ループカウンタ
Dim s(10) As String ''日付の一文字ずつ抽出用
Dim oldDB As String
Dim newDB As String
Try
FileOpen(1, cnsDB_file,OpenMode.Input) ''ファイルにアクセスされているかチェックする
FileClose(1)
strBe_sysdate = Today
For i = 1 ToLen(strBe_sysdate)''コピーファイル名の生成(ex:20060901.mdb)
If Mid(strBe_sysdate, i, 1) <> "/" Then
s(i - 1) = Mid(strBe_sysdate, i, 1)
strAF_sysdate = strAF_sysdate & s(i - 1)
End If
Next
Catch ex As Exception
''******************************************************************
''SetEventLog(ex.Message) イベントログへの書き込みロジック(エラー)
''******************************************************************
Exit Sub
End Try
Try
strCopydb = "F:" & strAF_sysdate & ".mdb"
''ファイルをコピーする
Microsoft.VisualBasic.FileSystem.FileCopy(cnsDB_file,strCopydb)
oldDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&cnsDB_file & ";Jet OLEDB:Database Password=FDMD;"
newDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= "&cndDB_clean & ";Jet OLEDB:Database Password=FDMD;"
JRO.CompactDatabase(oldDB, newDB) ''DB最適化処理
''バックアップ用に作成したコピーファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(strCopydb)
''インデックス前のファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(cnsDB_file)
Microsoft.VisualBasic.FileSystem.Rename(cndDB_clean,cnsDB_file)
''******************************************************************
''SetEventLog("正常終了") イベントログへの書き込みロジック(正常終了)
''******************************************************************
Catch ex As Exception
''コピーしたファイルを元に戻す
Microsoft.VisualBasic.FileSystem.FileCopy(strCopydb,cnsDB_file)
''コピーしたファイルを削除する
Microsoft.VisualBasic.FileSystem.Kill(strCopydb)
''******************************************************************
''SetEventLog(ex.Message) イベントログへの書き込みロジック(エラー)
''******************************************************************
Exit Sub
Finally
End Try
End Sub