VBA, MS Access MS Access в примерах

Подключение таблиц MySQL без DSN (ADOX или DAO)

По материалам https://support.microsoft.com/en-us/kb/230588

Требует установки MySQL ODBC драйвера

Установка драйвера ODBC MySQL:
   01. На страницу: http://dev.mysql.com/downloads/connector/odbc
       (Проще скачивать с: https://mirror.yandex.ru/mirrors/ftp.mysql.com/Downloads/Connector-ODBC/)
   02. Находите желаемую версию и скачиваете установочный пакет (Например: mysql-connector-odbc-8.0.22-winx64.msi).  
   03. Запускаете программу установки, все настройки по умолчанию.
   04. После установки можно сразу работать.

Ещё:
Как исправить “MySQL server has gone away” (error 2006)
https://www.it-rem.ru/kak-ispravit-mysql-server-has-gone-away-error-2006.html

По материалам: https://www.sql.ru/forum/723788/mysql-server-has-gone-away-2006
Добавил к своей строке подключения OBDC следующий текст - OPTION=4194304;,
что означает включить FLAG_ENABLE_RECCONECT, и все работает отлично.
И сервер теперь - has not gone away! Так сказать.



Модуль:

''--------------------------------------------------------------------------
' Module    : modLinkTablesMySQL
' Author    : es
' Date      : 21.08.2016
' Purpose   : Подлинковка таблиц MySQL с автоматическим созданием DSN (ADOX или DAO)
'--------------------------------------------------------------------------
'Для ADOX - Требуются ссылки на:
'    Microsoft ADO Ext. for DDL and Security. (Version 2.1 or higher)
'    Microsoft ActiveX Data Objects Library. (Version 2.1 or higher)
'--------------------------------------------------------------------

Public Sub LinkTablesMySQL_ADOX()
'Создание общей строки подключения и подлинковка таблиц MySQL
'--------------------------------------------------------------------------
Dim sDriver As String
Dim sServerAdr As String
Dim sServPort As String
Dim sDbName As String
Dim sUser As String
Dim sPassWord As String
Dim sConnect As String
Dim l&
'--------------------------------------------------------------------------
On Error GoTo LinkTablesMySQL_ADOX_Err
'Внимание - проверь версию драйвера! - Может уже выпустили: 8.10 или даже 11.2 ?

    sDriver = "{MySQL ODBC 8.8 Unicode Driver}"  'UNICODE Driver
    
    'sServerAdr = "localhost"
    sServerAdr = "127.0.0.1"   ' Адрес (Имя) сервера
    sServPort = "3306"         ' Порт соединения = 3306 (Обычно так и есть)
    sDbName = "codelibrary_db" ' Название базы
    sUser = "root"             ' Имя пользователя
    sPassWord = "Pass_Word"    ' Пароль


'Создаю строку подключения:
    sConnect = "ODBC;DRIVER=" & sDriver & _
        ";SERVER=" & sServerAdr & _
        ";Port=" & sServPort & _
        ";DATABASE=" & sDbName & _
        ";USER=" & sUser & _
        ";PASSWORD=" & sPassWord & _
        ";OPTION=3" 
        '";OPTION=4194304" & _
        ;ConnectionLifeTime=300; & _
        ";stmt=set names cp1251"
        '";stmt=set names utf8"
   'Debug.Print sConnect


    DoCmd.Hourglass True 'Показать часики

'--------------------------------------------------------------------
'Подключаем несколько таблиц по ADOX
    l = LinkTable_ADOX("table_name_01", sConnect)
    If l > 0 Then Err.Raise l
    
    l = LinkTable_ADOX("table_name_01", sConnect)
    If l > 0 Then Err.Raise l
        
    l = LinkTable_ADOX("table_name_03", sConnect)
    If l > 0 Then Err.Raise l
   
'--------------------------------------------------------------------------
'Подключаем пару таблиц по DAO
    l = LinkTable_DAO("table_name_04", sConnect, "table_name_04_DAO")
    If l > 0 Then Err.Raise l
    
    l = LinkTable_DAO("table_name_05", sConnect, "table_name_05_DAO")
    If l > 0 Then Err.Raise l

'Обновление Области Навигации (Navigation Pane)
    CurrentDb.TableDefs.Refresh
    Application.RefreshDatabaseWindow
    DoEvents

    Debug.Print "--------------------------------------------------"
    Debug.Print "Подключено: " & Now
    Debug.Print "--------------------------------------------------"

        
LinkTablesMySQL_ADOX_Bye:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    Exit Sub

LinkTablesMySQL_ADOX_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: LinkTablesMySQL_ADOX", vbCritical, "Error in module modConnectMySQL_DAO"
    Resume LinkTablesMySQL_ADOX_Bye
End Sub


Private Function LinkTable_ADOX(stRemTName As String, strConnect As String, Optional sLocalTName As String = "") As Long
'es 21.08.2016
'Подлинковка таблички MySQL Server с автоматическим созданием DSN (ADOX)
'При удачном подключениии возвращает = 0 (ноль), при неудачном = КОД ОШИБКИ (номер)
'-------------------------------------------------------------------------
'Аргументы:
'   stRemTName  = Имя таблицы на сервере
'   strConnect  = Строка подключения к серверу
'   sLocalTName = Локальное Имя Таблицы
'-------------------------------------------------------------------------
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
    
On Err GoTo LinkTable_ADOX_Err

'Если локальное имя не указанно
    If sLocalTName = "" Then sLocalTName = stRemTName
    
'Открываем каталог текущей базы
    Set cat.ActiveConnection = CurrentProject.Connection
    
'Если таблица с таким названием уже существует - Удаляем
    For Each tbl In cat.Tables
        If tbl.Name = sLocalTName Then cat.Tables.Delete tbl.Name
    Next
    
'Установка параметров таблицы
    With tbl
        .Name = sLocalTName
        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
    CurrentDb.TableDefs.Refresh
    DoEvents

LinkTable_ADOX_Bye:
    Set cat = Nothing
    Set tbl = Nothing
    Exit Function

LinkTable_ADOX_Err:
    LinkTable_ADOX = Err.Number
    Debug.Print "--------------------------------------------------"
    Debug.Print stRemTName & vbCrLf & "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "in Function: esLinkTable_ADOX"
    Resume LinkTable_ADOX_Bye
End Function


Private Function LinkTable_DAO(sSourceTblName As String, sConnectStr As String, Optional sLocalTblName As String = "") As Long
'es - 29.12.2012
'Создаёт подлинкованную таблицу по параметрам подключения с автоматическим созданием DSN (DAO)
'При удачном подключениии возвращает = 0 (ноль), при неудачном = КОД ОШИБКИ (номер)
'--------------------------------------------------------------------
'Аргументы:
'   sSourceTblName  = Имя Таблицы Исходное (на сервере)
'   sConnectStr     = Строка подключения к серверу:
'   sLocalTblTName  = Локальное Имя Таблицы (по умолчанию = sSourceTblName)
'--------------------------------------------------------------------
Dim tdf As New DAO.TableDef
    If sLocalTblName = "" Then sLocalTblName = sSourceTblName
'Удаляем старую подлинковку (если была)
    On Error Resume Next
    CurrentDb.TableDefs.Delete sLocalTblName
    Err.Clear
   
On Error GoTo LinkTable_DAO_Err
'Установка параметров создаваемой таблицы
    With tdf
        .Name = sLocalTblName
        .Connect = sConnectStr
        .SourceTableName = sSourceTblName
    End With
    
'Создаём новый обьект Таблица
    CurrentDb.TableDefs.Append tdf
    DoEvents
    CurrentDb.TableDefs.Refresh
    
LinkTable_DAO_Bye:
    On Error Resume Next
    Set tdf = Nothing
    Exit Function

LinkTable_DAO_Err:
    LinkTable_DAO = Err.Number
    Debug.Print "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
        "in procedure LinkTable_DAO", vbCritical, "Error!"
    Resume LinkTable_DAO_Bye
End Function



Результат может быть таким:

Picture

Achtung!
Разрядность MySQL ODBC драйвера - должна совпадать с разрядностью MSO (а не СИСТЕМЫ).
Т.Е. Если система x64, а MSO x86 (что довольно обычно), то - ставим драйвер - x86.

Для ADOX требуются ссылки на библиотеки:
    Microsoft ADO Ext. for DDL and Security. (Version 2.1 or higher)
    Microsoft ActiveX Data Objects Library. (Version 2.1 or higher)

Назад ToTop
L.E. 26.11.2024
Рейтинг@Mail.ru