Программное сжатие базы Access

Imports System.Data.OleDb
Imports System.Data.SqlClient
 
Public Class Form1
    Public DateDb, MyDate As Date
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
 
        Dim objADOXDatabase
        objADOXDatabase = CreateObject("ADOX.Catalog")
        objADOXDatabase.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password" ';Persist Security Info=False
 
        Dim cnn = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password")
        cnn.Open()
 
        If DateDb = Nothing Or DateDb <> MyDate Then
 
            ToolStripStatusLabel1.Text = "Проверяю базу данных на наличие таблиц"
 
            Try
                Dim cmdSelect4 As New OleDbCommand("SELECT * FROM OldPrice", cnn)
                cmdSelect4.ExecuteScalar()
 
                'Если таблица существует в базе то сначала удалим старую таблицу
                Dim Command1 As New OleDbCommand("DROP TABLE [OldPrice]", cnn)
                Command1.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет таблицы
 
                'Переименование таблицы
 
                objADOXDatabase.Tables("NewPrice").Name = "OldPrice"
                objADOXDatabase = Nothing
 
                'Создадим новую таблицу
                Dim command As New OleDbCommand("CREATE TABLE [NewPrice] ([Код] counter, [Otdel] INTEGER, [Lm_kod] INTEGER, [Price] MONEY)", cnn) 'Создаём таблицу с полями
                Dim command2 As New OleDbCommand("DELETE * FROM Price;", cnn) 'Очищаем таблице Price
                command.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет таблицы
                command2.ExecuteNonQuery() 'Выполняем SQL запрос, иначе таблицы не ощистится 
 
            Catch ex As Exception
 
                If DateDb <> Nothing Then
                    'Если таблица не существует то сначало переименуюем таблицу а потом создадим новую таблицу
                    objADOXDatabase.Tables("NewPrice").Name = "OldPrice"
                    objADOXDatabase = Nothing
 
                    'Создадим новую таблицу
                    Dim command As New OleDbCommand("CREATE TABLE [NewPrice] ([Код] counter, [Otdel] INTEGER, [Lm_kod] INTEGER, [Price] MONEY)", cnn) 'Создаём таблицу с полями
                    command.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет таблицы
                End If
            End Try
 
            Dim dt As New DataTable()
 
            ToolStripStatusLabel1.Text = "Начинаю выгрузку их Xpert"
 
            'Get Data into DataTable from Sql Server database
            Dim connection As New SqlConnection("[SQL запрос]")
            cmdSelect2.Connection = connection
            Dim ad1 As New SqlDataAdapter(cmdSelect2)
            ad1.AcceptChangesDuringFill = False
            ad1.Fill(dt)
            connection.Close()
 
            ToolStripStatusLabel1.Text = "Начинаю загружать данные в базу данных"
 
            'Insert Data from DataTable into Access database  
            Dim cmdSelect As OleDbCommand = New OleDbCommand("SELECT * FROM NewPrice")
            cmdSelect.Connection = cnn
            Dim ad2 As New OleDbDataAdapter(cmdSelect)
            Dim cmdBuilder As New OleDbCommandBuilder(ad2)
            Dim cmd As OleDbCommand = cmdBuilder.GetInsertCommand()
            cmd.Connection = cnn
            ad2.InsertCommand = cmd
            ad2.Update(dt)
 
            Dim SqlText As String
            If DateDb = Nothing Then
                SqlText = "INSERT INTO MyDate ([Дата]) VALUES ('" & MyDate & "')"
            Else
                SqlText = "UPDATE MyDate SET [Дата]='" & MyDate & "'"
            End If
            Dim SqlCom = New OleDb.OleDbCommand(SqlText, cnn)
            SqlCom.ExecuteNonQuery()
 
        End If
 
        ToolStripStatusLabel1.Text = "Загрузка выполнена"
 
        Try
            Dim cmdSelect1 As New OleDbCommand("SELECT * FROM OldPrice", cnn)
            cnn.Open()
            cmdSelect1.ExecuteScalar()
 
            Dim dta As New DataTable()
 
            ToolStripStatusLabel1.Text = "Производим вычисления и загружаем их в таблицу"
 
            'Get Data into DataTable from Sql Server database  
            Dim cmdSelect3 As OleDbCommand = New OleDbCommand("SELECT NewPrice.Otdel, NewPrice.Lm_kod, NewPrice.Price FROM NewPrice INNER JOIN OldPrice ON NewPrice.Lm_kod = OldPrice.Lm_kod WHERE ((([NewPrice].[Price]<>[OldPrice].[Price])=-1));")
            cmdSelect3.Connection = cnn
            Dim ad As New OleDbDataAdapter(cmdSelect3)
            ad.AcceptChangesDuringFill = False
            ad.Fill(dta)
 
            'Insert Data from DataTable into Access database  
            Dim cmdSelect2 As OleDbCommand = New OleDbCommand("SELECT * FROM Price")
            cmdSelect2.Connection = cnn
            Dim ad3 As New OleDbDataAdapter(cmdSelect2)
            Dim cmdBuilder As New OleDbCommandBuilder(ad3)
            Dim cmd As OleDbCommand = cmdBuilder.GetInsertCommand()
            cmd.Connection = cnn
            ad3.InsertCommand = cmd
            ad3.Update(dta)
        Catch ex As Exception
 
        End Try
 
        cnn.Close()
        cnn.Dispose()
        cnn = Nothing
        objADOXDatabase = Nothing
 
        ToolStripStatusLabel1.Text = "Начинаю сжимать базу данных"
 
        'Сжатие базы
        Dim jro As New JRO.JetEngine
        Try
            jro.CompactDatabase("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password", _
            "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\TempReport.accdb;Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=password")
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        Finally
            jro = Nothing
        End Try
 
        ToolStripStatusLabel1.Text = "База данных сжата"
 
        'Удалим старый файл
        IO.File.Delete("C:\Report.accdb")
 
        'Надо теперь C:\TempReport.accdb переименовать в C:\Report.accdb
        My.Computer.FileSystem.RenameFile("C:\TempReport.accdb", "Report.accdb")
 
        ToolStripStatusLabel1.Text = "Готово"
 
    End Sub
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
 
        ToolStripStatusLabel1.Text = "Получаю текущую дату"
        MyDate = Date.Today
        ToolStripStatusLabel1.Text = "Дата получина"
 
        If IO.File.Exists("C:\Report.accdb") = False Then 'Если БД не создана то создадим её
            ToolStripStatusLabel1.Text = "Создаю базу данных"
            'Создание БД с паролем + создание таблиц с полями
            Dim cat As New ADOX.Catalog
            cat.Create("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password") 'Создаём БД
            cat = Nothing
            ToolStripStatusLabel1.Text = "База данных создана"
 
            Dim connection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password")
            connection.Open()
 
            Dim command As New OleDbCommand("CREATE TABLE [NewPrice] ([Код] counter, [Otdel] INTEGER, [Lm_kod] INTEGER, [Price] MONEY)", connection) 'Создаём таблицу с полями
            Dim command2 As New OleDbCommand("CREATE TABLE [MyDate] ([Код] counter, [Дата] DATE)", connection) 'Создаём вторую таблицу с полями
            Dim command3 As New OleDbCommand("CREATE TABLE [Price] ([Код] counter, [Otdel] INTEGER, [Lm_kod] INTEGER, [Price] MONEY)", connection) 'Создаём таблицу с полями
            command.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет таблицы
            command2.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет второй таблицы
            command3.ExecuteNonQuery() 'Выполняем SQL запрос, иначе не будет третьей таблицы
            connection.Close()
            connection.Dispose()
            connection = Nothing
        End If
 
        If IO.File.Exists("C:\Report.accdb") = True Then
            Dim connection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Report.accdb;Jet OLEDB:Database Password=password")
            connection.Open()
            ToolStripStatusLabel1.Text = "Получаю дату из базы данных"
            Dim CommDate As New OleDbCommand("SELECT [Дата] FROM MyDate", connection)
            DateDb = CommDate.ExecuteScalar()
            connection.Close()
            connection.Dispose()
            connection = Nothing
            ToolStripStatusLabel1.Text = "Дата из базы данных получина"
        End If
 
    End Sub

Dim jro As JRO.JetEngine
jro = New JRO.JetEngine()
jro.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=sst.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=sst.mdb;Jet OLEDB:Engine Type=5")

        SqlCom = New OleDb.OleDbCommand("DELETE * FROM [nSST]", Con) 'SQL-запрос на очистку всех элементов из таблицы nSST базы подключеной в переменной Con
        Con.Open() 
        SqlCom.ExecuteNonQuery() 'применяем запрос
        Con.Close()
        Dim je As New JRO.JetEngine
        'база sst.mdb сохраняется в сжатом виде в базу newsst.mdb
        je.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=sst.mdb", _
        "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=newsst.mdb")
        IO.File.Delete("sst.mdb")'удаляем несжатую базу
        Rename("newsst.mdb", "sst.mdb") 'меняем имя у сжатой базы
        je = Nothing