1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
| 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 |
(
Сообщение от Alex063
Если найду что-нибудь стоящее поделюсь обязательно.
Сообщение было отмечено Памирыч как решение
