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

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

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

Установка драйвера ODBC MySQL:
   01. На страницу: http://dev.mysql.com/downloads/connector/odbc
       (Проще скачивать с: http://mirror.cogentco.com/pub/mysql/Connector-ODBC/)
   02. Находите желаеемую версию и скачиваете инсталлятор (Например:mysql-connector-odbc-5.3.4-win32.msi).  
   03. Запускаете инсталлятор, все настройки по умолчанию.
   04. После установки можно сразу работать.

Модуль:

'--------------------------------------------------------------------

' Module : modLinkTablesMySQL

' Author : es

' Date : 21.08.2016

' Purpose : Подлинковка таблиц MySQL с автоматическим созданием DSN (ADOX или DAO)

'--------------------------------------------------------------------------

'Требуются ссылки на:

' 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

'Внимание - проверь версию драйвера! - Может уже... 5.5 или даже 6.2!?

'sDriver = "{MySQL ODBC 5.2 ANSI Driver}" 'ANSI Driver

sDriver = "{MySQL ODBC 5.3 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" '& _

";stmt=set names cp1251"

'";stmt=set names utf8"

'Debug.Print sConnect

'--------------------------------------------------------------------

'Подключаем несколько таблиц по 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

LinkTablesMySQL_ADOX_Bye:

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 "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

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

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

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