Ошибка 27211 ошибка при включении самозащиты ошибка 2147467259

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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

Option Compare Database
Option Explicit
 
'--------------------------------------------------------------------------
' Module    : modLink_MySQL_ADOX
' Author    : es
' Date      : 24.07.2017
' Purpose   : Переподключение таблиц MySQL без DSN
'--------------------------------------------------------------------------
' - Требует установки MySQL ODBC ODBC MySQL драйвера
'--------------------------------------------------------------------------
'Требуются ссылки на:
'    Microsoft ADO Ext. for DDL and Security. (Version 2.1 or higher)
'    Microsoft ActiveX Data Objects Library. (Version 2.1 or higher)
'--------------------------------------------------------------------------
 
 
Public ConnStr$
Private cat As ADOX.Catalog
Private tbl As ADOX.Table
Private AConnectionString_ADOX As String
Private i%, s$
 
Public Sub StartReLink_MySQL_ADOX(Optional bDelOnly As Boolean)
'Собственно процедура подключения (основная)
 
Dim arrTables() As Variant
Dim arrTables_1() As Variant
 
'--------------------------------------------------------------------------
On Error GoTo StartReLink_MySQL_ADOX_Err
    DoCmd.Hourglass True 'Показать часики
 
 
'Массив табличек:
    arrTables = Array("Amper", "Baza", "Baza_Pitatel", "Cat_Empl", "Chet", "Chet_Kompl", "Cklad", "Vid_Nomenkl_ERP", "Klaccif_Nomenkl_ERP", "Uroven_Ctrykt_ERP", _
        "Cklad_Dvig_Izd", "Cod_Empl", "Cotrydnik", "Cpecifikaciy", "Cpecifikaciy_Pza1", "Cpr_Nomenkl_ERP", "Ctryktyra_Izdely_ERP", _
        "Cpocob_Per_Zak", "Cpr_Dorabotok", "Ctr_Izd_Modyl", "Ctr_Izd_Ocnov", "Ctrana", "Licev_Nakl_Izdelie", "Licev_Nakl_Plan_Vipycka_Izd", "Licev_Nakl_Prixod", "Licev_Nakl_Racxod", "Izdelie_Licev", _
        "Ctryktyra_Izdely", "Cvoictva_Znach", "Cvoictvo_Detali", "Dolznoct", "Dop_Zamena", "Operacii_ERP", "Izdely_Operacii_ERP", _
        "Edinicy_Izmereny", "Forma_Cobctv", "Funk_Claim", "Funk_Otvetctv_Za_Vip", _
        "Funk_Pol_Inform", "Funk_Procecc", "Funk_Structure", "Funk_View", "Funk_Ychactv_V_Vip", _
        "Gorod", "Grup_Empl", "Gryp_Clozn_Rem", "Icpolnenie", "Identifikator_Izd", _
        "Invent_Cklad", "Izdelie", "Izdelie_copy", "Izdelie_Komplekty", "Izd_Preemnik", "Izdelie_Modifikaciy", "Izdelie_TO", _
        "Izdely_Gryp", "Izv_Cogl", "Izv_Cogl_Jyrnal_Cob", "Izv_Ctatyc", "Izv_Formylirovki", _
        "Izv_Izdelie", "Izv_Jyrnal_Cob", "Izv_Koment", "Izv_Koment_Jyrnal_Cob", "Izv_Modul", "Izv_Kritichnoct", _
        "Izv_Vid_Cogl", "Izveshenie", "Level_Competence", "Mecto_Xraneniy", "Modifikaciy", _
        "Modyl", "Name_Funk", "Name_Group", "NameFunk", "Necootvetctv", "Oboryd_TO", _
        "Oborydovanie", "Ogr_Cpicok", "ooDecim_Nomer", "ooGryppa_Izd", "ooKlacc_Izd", _
        "ooPodgryppa_Izd", "ooPodklacc_Izd", "ooPor_Regictr_Nomer", "ooVid_Izd", "Operaciy_Cklad", _
        "Operaciy_Oboryd", "Operaciy_Texnol", "Operaciy_Vipol", "Opicanie_Cvoictv", "Org_Ctrykt", _
        "Organizat_Role", "Otdel", "Pitatel", "Bab_Fid_Yct", "Fider", "Fider_Kompon_Progr", "Fider_Pit", _
        "Racpolozenie", "Pitatel_Partia", "Pitatel_Xarakter", "Plata_Defekt", "Poctavchik", _
        "Porycheniy", "Prichina_Vozvr_Iz_OTK", "Privyzka_Coctava", "Process", "Process_A", "Progr", "TP_Mex", "TP_Mex_Vibor", "TP_Mex_Vipoln", "Partiy_Mex", "Peremesh_Mex", _
        "Proizvod", "R_RA", "Rabota_Robotov", "Requ_For_Specialty", "Site", "Sites_1", "Texprocecc", _
        "Tip_Dokym", "Tip_Operaciy", "To_I_R", "To_I_R_Prichina", "To_I_R_Cherez_Cklad", "To_I_R_Cherez_Cklad_copy", "Obmenniy_Fond", "To_Izd", "Imiy_Shkafa", "To_Izd_Cpicok_Rab", _
        "To_Obor_Cpicok_Rab", "Verciy_PO", "Verciy_Po_Aktualn", "Vid_Rabot", "Vid_Rabot_To", _
        "Vizm_Neicpr_Napominal", "Vozm_Neicpr_Priborov", "Volt", "Vozvrat_Iz_Otk", "Vxod_Kontrol", "Zakaz", "Zakazchik", "Bx_Kontr_Nomenkl", "Bx_Kontr_Zyrnal", "Cootvetctvie", _
        "Zip", "Zip_Cklad", "Zip_Cklad_Racxod", "Zip_Dvigenie", "Zip_Imia", "Zip_Mex_Cbor", "Klacter_Remonta", "Klacter_Remonta_Org", _
        "Zip_Partiy", "Zip_Partiy_Brem_Nakleika", "Zip_Poctavshik", "Zip_Vid", "Zip_Ynikaln", "Izdelie_Verciy_PO", "Dokyment", _
        "Imenovanie", "Klassif_Schtrix", "Texprocecc_Izd", "Klaccif_Nomer_PO", "Reviziy_PO", "Tip_Failov_PO", "Remont", "Kod_1_Panel_IHM", "Kod_2_Panel_IHM", "Kod_3_Panel_IHM", "Kod_4_Panel_IHM", "Kod_Coctav_Modyley_VV", "Kod_Tip_Mezonina_Cviazi", "Kod_Tip_Modyl_Proceccora", "Kod_Tip_Razmeri_Korpyca", "Kod_Vercii_PO", "Ciriyc_New", "Ciriyc_New_Racborka")
    'arrTables = Array("Uroven_Ctrykt_ERP", "Cpr_Nomenkl_ERP", "Ctryktyra_Izdely_ERP", "Operacii_ERP", "Izdely_Operacii_ERP")
 
'--------------------------------------------------------------------------
'Предварительный промсмотр (если нужно):
    Debug.Print String(74, "-")
    For i = LBound(arrTables) To UBound(arrTables)
        s = arrTables(i)
        Debug.Print Format(i + 1, "000"); ".  " & s
    Next i
    Debug.Print String(74, "-")
    Debug.Print "Всего: " & Format(i, "00") & " таблиц " & Now
    Debug.Print String(74, "-")
'--------------------------------------------------------------------------
    'GoTo StartReLink_MySQL_ADOX_Bye
    
'Запуск
    'ReLinkTables_ADOX arrTables, "00_", bDelOnly    ' Полное переподключение
    ReLinkTables_ADOX arrTables, , bDelOnly    ' Полное пере-подключение
 
StartReLink_MySQL_ADOX_Bye:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    Exit Sub
 
StartReLink_MySQL_ADOX_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure: StartReLink_MySQL_ADOX in module: modLink_MySQL_ADOX", _
    vbCritical, "Error in Application!": Err.Clear
    Resume StartReLink_MySQL_ADOX_Bye
        
End Sub
 
Private Sub ReLinkTables_ADOX(arrTables() As Variant, Optional sTblLocalPrefix$ = "", Optional bDelOnly As Boolean)
' Вспомогательная -  Переподключение таблиц по массиву
'--------------------------------------------------------------------------
'Аргументы:
'   arrTables()      = Массив табличек
'   sTblLocalPrefix  = Локальный префикс названий
'   bDelONly         = Только удалить и не подключать если = True (-1)
'--------------------------------------------------------------------------
Dim sTblName$
Dim sDriver As String
Dim sServerAdr As String
Dim sCharset As String
Dim sServPort As String
Dim sDbName As String
Dim sUser As String
Dim sPassWord As String
Dim l&
 
On Error GoTo ReLinkTables_ADOX_Err
 
    
    If Dir("C:Program FilesMySQLConnector ODBC 3.51", vbDirectory) <> "" Then
        sDriver = "{MySQL ODBC 3.51 Driver}" 'Папка Connector ODBC 3.51 существует. Драйвер для 32 разрядной операционной системы(для устаревших компьютеров- где дополниетльные программы (требующиеся для работы этого драйвера) плохо или не ставятся вовобще)
    ElseIf Dir("C:Program FilesMySQLConnector ODBC 5.3", vbDirectory) <> "" Then
        sDriver = "{MySQL ODBC 5.3 Unicode Driver}" 'Драйвер для 32 или драйвер для 64 разрядного MS Office - в зависимости , что установлено. Имя папки одинаковое.
    Else
        MsgBox "Нет драйвера ODBC для работы с  MySQL"
        Exit Sub
    End If
    
    'sServerAdr = "localhost"
    sServerAdr = "managementdb.rza.ru"   ' Адрес (Имя) сервера
    sServPort = "3306"         ' Порт соединения = 3306 (Обычно так и есть)
    sDbName = "management" ' Название базы
    sUser = "management"             ' Имя пользователя
    sPassWord = "123456"    ' Пароль
 
s = ""
'Создаю строку подключения:
 ConnStr = ";DRIVER=" & sDriver & _
        ";SERVER=" & sServerAdr & _
        ";Port=" & sServPort & _
        ";DATABASE=" & sDbName & _
        ";USER=" & sUser & _
        ";PASSWORD=" & sPassWord & _
        ";OPTION=3" & _
        ";stmt=set names cp1251"
        Debug.Print ConnStr
        Debug.Print String(74, "-")
    
    
'Строим строку подключения ... - добавляем "ODBC;" в начало уже готовой (см выше)
    AConnectionString_ADOX = "ODBC;" & ConnStr
 
'Катплог
    Set cat = New ADOX.Catalog
    'Открываем каталог текущей базы
    Set cat.ActiveConnection = CurrentProject.Connection
 
'Удаление всех таблиц по именам
     For i = LBound(arrTables) To UBound(arrTables)
        sTblName = arrTables(i)
        s = sTblLocalPrefix & sTblName
        DelTable_ADOX s
    Next i
    cat.Tables.Refresh
    Debug.Print String(74, "-")
 
    If bDelOnly = True Then GoTo ReLinkTables_ADOX_Bye
'Подключение  всех по именам
    For i = LBound(arrTables) To UBound(arrTables)
        sTblName = arrTables(i)
        'Debug.Print Format(i, "000") & " - " & sTblName
        LinkTable_ADOX sTblName, AConnectionString_ADOX, sTblLocalPrefix & sTblName
    Next i
    
'Отчёт о проделанной работе
    'Debug.Print String(74, "-")
    Debug.Print "Подключено: " & Format(i, "000") & " таблиц " & Now
    Debug.Print String(74, "-")
 
    
ReLinkTables_ADOX_Bye:
    On Error Resume Next
    'Обновляем список таблиц
    cat.Tables.Refresh
    
    cat.ActiveConnection.Close
    Set cat = Nothing
    Set tbl = Nothing
    
    'Keep_ADO_Connection
    Exit Sub 'Ура!!!
 
ReLinkTables_ADOX_Err:
    s = "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "In procedure: ReLinkTables_ADOX in module: modCommon_ADOX"
    Debug.Print s
    MsgBox s, vbCritical, "Error in Application!"
    Err.Clear
    Resume ReLinkTables_ADOX_Bye
End Sub
Private Sub DelTable_ADOX(s$)
'Удаление подлинковки.
    On Error Resume Next
    cat.Tables.Delete s
    If Err = 0 Then Debug.Print s & " ... Deleted!"
    Err.Clear
End Sub
 
Private Sub LinkTable_ADOX(stRemTName As String, strConnect As String, Optional strLocalTableName As String = "")
'es 08.05.2017
'Подлинковка таблички MySQL Server с автоматическим созданием DSN (ADOX)
'Использует общие переменные данного модуля (так короче и возможно быстрее)
'-------------------------------------------------------------------------
'Аргументы:
'   stRemTName  = Имя таблицы на сервере
'   strConnect  = Строка подключения к серверу с "ODBC:DRIVER = ..."
'   strLocalTableName = Локальное Имя Таблицы
'-------------------------------------------------------------------------
 
On Err GoTo LinkTable_ADOX_Err
'Если локальное имя не указанно
    If strLocalTableName = "" Then strLocalTableName = stRemTName
    
     Set tbl = New ADOX.Table
 
'Установка параметров таблицы
    With tbl
        .Name = strLocalTableName
        Set .ParentCatalog = cat
        .Properties("Jet OLEDB:Link Provider String") = strConnect
        .Properties("Jet OLEDB:Remote Table Name") = stRemTName
        .Properties("Jet OLEDB:Create Link") = True
    End With
    
'Создаём новый обьект
    cat.Tables.Append tbl
    'cat.Tables.Refresh
    
LinkTable_ADOX_Bye:
    Exit Sub
 
LinkTable_ADOX_Err:
    'LinkTable_ADOX = Err.Number
    Debug.Print "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "in Function: esLinkTable_ADOX"
    Resume LinkTable_ADOX_Bye
End Sub